main.bas

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

Attribute VB_Name = "MainModule"
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Option Explicit

Public fMainForm As frmMain
Public GCmdHelper As CCommandSupportModule
Public GInputID As CInputIdentification
Public GOutputID As COutputIdentification
Public GImport As CImport
Public GAppPreferences As CPreferences
Public Archive As CArchive
Public GDataConverter As CDataConverter
Private mLogFileHandle As Integer
Private mLogFileName As String
Private mErrorCount

#Const GDemoCode = False
#If GDemoCode Then
    Global Const GCompileDate = "11/1/99"
    Global Const GMonthsToRun = 2
#End If

Sub Main()
    On Error Resume Next
    
    #If GDemoCode Then
        If DateDiff("m", GCompileDate, Now) > GMonthsToRun Then
            End
        End If
    #End If
    
    mErrorCount = 0

    mLogFileHandle = -1

    '************************************
    ' Set up all of our global variables.
    '************************************
    
    InitializeGlobals
    
    Set GImport = New CImport
    Set Archive = New CArchive
    Set GInputID = New CInputIdentification
    Set GOutputID = New COutputIdentification
    Set GAppPreferences = New CPreferences
    Set GDataConverter = New CDataConverter
    Set GCmdHelper = New CCommandSupportModule
    
    ' Load preferences.
    Dim arc As New CArchive
    arc.fileName = GWorkingDirectory & "\DataMonkey.ini"
    GAppPreferences.Load arc
    
    ' Get the data path.
    If GAppPreferences.GetPreference("ApplicationPath") <> "" Then
        ' Set the application path.
        GWorkingDirectory = GAppPreferences.GetPreference("ApplicationPath")
    End If
    
    ' Login the user.
    'fLogin.Show vbModal
    'If Not fLogin.OK Then
        'Login Failed so exit app
    '    End
    'End If
    'Unload fLogin

    frmSplash.Show
    frmSplash.Refresh
    Set fMainForm = New frmMain
    Load fMainForm
    Unload frmSplash

    fMainForm.Show

    ' Get the filename.
    fMainForm.dlgTemplateDialog.fileName = GTemplateDirectory & "\*.tpl"
    fMainForm.dlgTemplateDialog.DefaultExt = "tpl"
    fMainForm.dlgTemplateDialog.Filter = "Template files (*.tpl)|*.tpl|All files (*.*)|*.*"
    fMainForm.dlgTemplateDialog.DialogTitle = "Select Template file"

    
    fMainForm.dlgTextDialog.fileName = GWorkingDirectory & "\*.txt"
    fMainForm.dlgTextDialog.DefaultExt = "txt"
    fMainForm.dlgTextDialog.Filter = "Text files (*.txt)|*.txt|All Files (*.*)|*.*"

    fMainForm.dlgCommonDialog.fileName = GWorkingDirectory & "\*.import"
    fMainForm.dlgCommonDialog.DefaultExt = "*.*"

    ' Disable cut/copy/paste.
    tiEnableCutCopyPaste False, False, False

End Sub

Sub LoadResStrings(frm As Form)

    On Error Resume Next

    Dim ctl As Control
    Dim obj As Object
    Dim fnt As Object
    Dim sCtlType As String
    Dim nVal As Integer


    'set the form's caption
    frm.Caption = LoadResString(CInt(frm.tag))
    
    'set the font
    Set fnt = frm.Font
    fnt.name = LoadResString(20)
    fnt.Size = CInt(LoadResString(21))
    
    'set the controls' captions using the caption
    'property for menu items and the Tag property
    'for all other controls
    For Each ctl In frm.Controls
        Set ctl.Font = fnt
        sCtlType = TypeName(ctl)
        If sCtlType = "Label" Then
            ctl.Caption = LoadResString(CInt(ctl.tag))
        ElseIf sCtlType = "Menu" Then
            ctl.Caption = LoadResString(CInt(ctl.Caption))
        ElseIf sCtlType = "TabStrip" Then
            For Each obj In ctl.Tabs
                obj.Caption = LoadResString(CInt(obj.tag))
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "Toolbar" Then
            For Each obj In ctl.Buttons
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "ListView" Then
            For Each obj In ctl.ColumnHeaders
                obj.Text = LoadResString(CInt(obj.tag))
            Next
        Else
            nVal = 0
            nVal = val(ctl.tag)
            If nVal > 0 Then ctl.Caption = LoadResString(nVal)
            nVal = 0
            nVal = val(ctl.ToolTipText)
            If nVal > 0 Then ctl.ToolTipText = LoadResString(nVal)
        End If
    Next

End Sub

Function GetLogFileName() As String
    GetLogFileName = mLogFileName
End Function

Sub ResetErrorCount()
    mErrorCount = 0
End Sub

Function GetErrorCount() As Integer
    GetErrorCount = mErrorCount
End Function

Function OpenLogFile(HeaderString As String, Optional ByVal LogFileName As String = "", Optional OverwriteLogfile As Boolean = True) As Boolean
    On Error Resume Next
    OpenLogFile = False

    ' Make sure we have a filename.
    If LogFileName = "" Then
        LogFileName = GWorkingDirectory & "\Import.Log"
    End If

    If Not mLogFileHandle = -1 Then
        CloseLogFile
    End If
    
    mLogFileName = LogFileName
    
    'Open the logfile.
    mLogFileHandle = FreeFile
    If OverwriteLogfile Then
        Open LogFileName For Output As mLogFileHandle
    Else
        Open LogFileName For Append As mLogFileHandle
    End If

    If Err <> 0 Then
        mLogFileHandle = -1
        LogError "MainModule", "OpenLogFile", _
            Error(Err) & vbCrLf _
            & "Error opening log file: " & LogFileName & vbCrLf _
            & "Check the logfile setting in the Import Properties." & vbCrLf _
            & "Error messages will be displayed on screen", False
        Exit Function
    End If
    
    On Error GoTo eHandler

    ' Print an extra return between logs.
    If LOF(mLogFileHandle) > 0 Then Print #mLogFileHandle,
    
    ' Log Import Header.
    LogComment "Begin Logging" & vbCrLf & HeaderString

    OpenLogFile = True
    Exit Function

eHandler:
    LogError "MainModule", "OpenLogFile", Error(Err), False
    CloseLogFile
    
End Function

Sub LogComment(cmt As String, Optional BorderChar As String = "*")
    Dim i As Integer

    If mLogFileHandle < 0 Then Exit Sub
    Dim TimeStamp As String
    
    TimeStamp = Format(Now, "DDD MMM DD, YYYY hh:mm:ss AMPM")
    
    i = FindLongestLine(TimeStamp)
    If i < FindLongestLine(cmt) Then
        i = FindLongestLine(cmt)
    End If
    
    ' Print a return.
    If LOF(mLogFileHandle) > 0 Then Print #mLogFileHandle,

    Print #mLogFileHandle, String(i, BorderChar)
    Print #mLogFileHandle, TimeStamp
    Print #mLogFileHandle, cmt
    Print #mLogFileHandle, String(i, BorderChar)

End Sub

Function FindLongestLine(str As String) As Integer
    Dim longest As Integer
    Dim cur As Integer, prev As Integer
    
    ' Find the first crlf.
    cur = InStr(str, vbCrLf)
    
    ' If there is not crlf, the string is one line.
    If cur = 0 Then
        FindLongestLine = Len(str)
        Exit Function
    Else
        FindLongestLine = cur
    End If

    ' Find the longest set of characters between crlf's.
    While cur > 0
        prev = cur
        cur = InStr(cur + 1, str, vbCrLf)
        
        If cur = 0 Then
            If Len(str) - prev > longest Then
                longest = Len(str) - prev
            End If
        Else
            If cur - prev > longest Then
                longest = cur - prev - 1
            End If
        End If
    Wend
    
    FindLongestLine = longest - 1
End Function

Sub CloseLogFile()
    Close mLogFileHandle
    mLogFileHandle = -1
    mLogFileName = ""
End Sub

Sub LogError(ModName As String, FuncName As String, eString As String, Optional ByVal quiet = True)
    Dim Msg As String
    Dim line As Long
    Dim item As Variant
    Dim t As String

    mErrorCount = mErrorCount + 1

    ' If there is no open log file, we can't log the error.
    If mLogFileHandle < 0 Then quiet = False
    
    If GImportInProgress Then
        Dim op As String, Tbl As String, fld As String, val As Variant
        
        GImport.GetOutputObject.GetLoggingInfo op, Tbl, fld, val
        
        line = GImport.GetInputObject.GetLineNumber()
        item = GImport.GetInputObject.GetLastItemReferenced()
        Msg = "  Error: " & eString & vbCrLf & vbCrLf
        Msg = Msg & "  Input Source" & vbCrLf
        Msg = Msg & "    File Name: " & GImport.GetInputObject.fileName() & vbCrLf
        Msg = Msg & "    Line Number: " & GImport.GetInputObject.GetLineNumber() & vbCrLf
        Msg = Msg & "    Last Item referenced: " & GImport.GetInputObject.GetLastItemReferenced() & vbCrLf & vbCrLf
        Msg = Msg & "  Output Source" & vbCrLf
        Msg = Msg & "    File Name: " & GImport.GetOutputObject.fileName() & vbCrLf
        Msg = Msg & "    Last Operation: " & op & vbCrLf
        Msg = Msg & "    Last Table Referenced: " & Tbl & vbCrLf
        Msg = Msg & "    Last Field Referenced: " & fld & vbCrLf
        Msg = Msg & "    Last Value Referenced: " & val & vbCrLf & vbCrLf

        Dim cnvTo As String, cnvFrom As String
        GDataConverter.GetErrorLogInfo Tbl, fld, val, cnvTo, cnvFrom

        Msg = Msg & "  Last Data Conversion" & vbCrLf
        Msg = Msg & "    Table: " & Tbl & vbCrLf
        Msg = Msg & "    Field: " & fld & vbCrLf
        Msg = Msg & "    Value: " & val & vbCrLf
        Msg = Msg & "    Type Converting To: " & cnvTo & vbCrLf
        Msg = Msg & "    Type Converting From: " & cnvFrom & vbCrLf
    
        'Log to file.
        If quiet Then
            t = Format(Now, "DDD MMM DD, YYYY hh:mm:ss AMPM")
            t = t & " - Module: " & ModName & ", " & "Function: " & FuncName
            Print #mLogFileHandle, String(Len(t), "-")
            Print #mLogFileHandle, t & vbCrLf
            Print #mLogFileHandle, Msg

        Else
            Dim i As Integer
            i = MsgBox(Msg, vbOKCancel Or vbInformation, ModName + ": " + FuncName)
            If i = vbCancel Then
                GCancelImport = True
            End If
        End If
    
    Else
        Msg = eString
    
        If quiet Then
            t = Format(Now, "DDD MMM DD, YYYY hh:mm:ss AMPM")
            t = t & " - Module: " & ModName & ", " & "Function: " & FuncName
            Print #mLogFileHandle, String(Len(t), "-")
            Print #mLogFileHandle, t & vbCrLf
            Print #mLogFileHandle, Msg
        Else
            MsgBox Msg, vbOKOnly Or vbInformation, ModName + ": " + FuncName
        End If
    
    End If
    
End Sub

Function GetDelimitedItem(ItemNumber As Integer, Delimiter As String, DelimitedString As String) As String
    
    Dim i As Integer
    Dim j As Integer
    j = 1
    
    GetDelimitedItem = ""
    
    ' Locate the desired left side delimiter.
    For i = 1 To ItemNumber - 1
        j = InStr(j, DelimitedString, Delimiter)
        If j < 1 Then Exit Function
        j = j + 1
    Next i
    
    ' Get the right delimiter if there is one.
    i = InStr(j, DelimitedString, Delimiter)
    If i < 1 Then
        GetDelimitedItem = right$(DelimitedString, Len(DelimitedString) - j)
    Else
        GetDelimitedItem = Mid$(DelimitedString, j, i - 1)
    End If
End Function

Public Sub MainDocumentVisible(Optional Visible)
    Dim i As Boolean
    
    If IsMissing(Visible) Then
        i = Not fMainForm.mnuViewProjectWindow.Checked
    Else
        i = Visible
    End If
    
    fMainForm.mnuViewProjectWindow.Checked = i
    frmDocument.Visible = i
End Sub