Attribute VB_Name = "basMain"
Option Explicit
' ***************************************************************************
' Module: basMain.bas
'
' Description: This module contains some of the most common routines I use
' along with some that are just common to this application.
'
' ===========================================================================
' DATE NAME / eMAIL
' DESCRIPTION
' ----------- --------------------------------------------------------------
' 29-DEC-2000 Kenneth Ives kenaso@home.com
' ***************************************************************************
' ---------------------------------------------------------------------------
' Define variables
' ---------------------------------------------------------------------------
Public g_strVersion As String
Public g_blnStopProcessing As Boolean
Public Const DEFAULT_DATE As String = "01/01/1980 12:00 AM"
Public Sub Main()
' ---------------------------------------------------------------------------
' Set up the path where all of the processing will take place.
' ===========================================================================
' DATE NAME DESCRIPTION
' ----------- ------------------------ ------------------------------------
' 10-DEC-2000 Kenneth Ives Written by kenaso@home.com
' ---------------------------------------------------------------------------
ChDrive App.Path
ChDir App.Path
' ---------------------------------------------------------------------------
' See if there is another instance of this program running
' ---------------------------------------------------------------------------
If App.PrevInstance Then
Exit Sub
End If
' ---------------------------------------------------------------------------
' Initialize global settings
' ---------------------------------------------------------------------------
g_strVersion = "Zip Dater v" & App.Major & "." & App.Minor
' ---------------------------------------------------------------------------
' Load all the screens. If these were intensive forms, I would use a splash
' screen to keep the user occupied while they loaded into memory.
' ---------------------------------------------------------------------------
Load frmAbout
Load frmMain
End Sub
Public Sub StopApplication()
' ---------------------------------------------------------------------------
' Unload all forms then terminate application
' ===========================================================================
' DATE NAME DESCRIPTION
' ----------- ------------------------ ------------------------------------
' 10-DEC-2000 Kenneth Ives Written by kenaso@home.com
' ---------------------------------------------------------------------------
Unload_All_Forms
End
End Sub
Public Sub Unload_All_Forms()
' ---------------------------------------------------------------------------
' Unload all forms before terminating an application. The calling module
' will call this routine and usually executes END when it returns.
' ===========================================================================
' DATE NAME DESCRIPTION
' ----------- ------------------------ ------------------------------------
' 10-DEC-2000 Kenneth Ives Written by kenaso@home.com
' ---------------------------------------------------------------------------
' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
Dim frm As Form
' ---------------------------------------------------------------------------
' As we find a form, we will unload it and free memory.
' ---------------------------------------------------------------------------
For Each frm In Forms
If TypeOf frm Is Form Then
frm.Hide ' Hide the form
Unload frm ' Deactivate the form object
Set frm = Nothing ' Free form object from memory
End If
Next
End Sub
Public Function StrSearch(strData As String, _
strSearchFor As String, _
Optional blnReplace As Boolean = False, _
Optional blnLastOccurance As Boolean = False, _
Optional blnMatchCase As Boolean = False, _
Optional blnCountOccurances As Boolean = False) As Long
' ***************************************************************************
' Routine: StrSearch
'
' Description: This routine is used to search a string of data. Options
' are whether or not to replace found data, find the first
' or last occurance of the SearchFor item and number of
' occurances based on case.
'
' Parameters: strData - data string to be searched (parsed)
' strSearchFor - data to look for in strData
' blnReplace [Optional] - [Default] False - do not replace
' True - replace found data with search data
' blnLastOccurance - [Optional] [Default] False - Do not return
' numeric position of last occurance of search
' item in data string
' True - Return numeric position
' blnMatchCase [Optional] - [Default] False - this is not a
' case sensitive comparison (vbTextCompare)
' True - this is a case sensitive comparison
' of data (vbBinaryCompare)
' blnCountOccurances [Optional] - [Default] False - Do not
' return a count of the number of occurances
' found in the data string
' True - Return a count value
'
' Returns: A long value based on flags above
'
' ===========================================================================
' DATE NAME DESCRIPTION
' ----------- --------------- ---------------------------------------------
' 03-MAR-2001 Kenneth Ives Module created by kenaso@home.com
' ***************************************************************************
' -----------------------------------------------------------------------------
' Define local variables
' -----------------------------------------------------------------------------
Dim lngFirstPosition As Long
Dim lngLastPosition As Long
Dim lngIndex As Long
Dim lngDataLen As Long
Dim lngSearchLen As Long
Dim lngCount As Long
Dim strTest As String
' -----------------------------------------------------------------------------
' Initialize variables
' -----------------------------------------------------------------------------
lngFirstPosition = 0
lngLastPosition = 0
lngCount = 0
lngDataLen = Len(strData)
lngSearchLen = Len(strSearchFor)
' -----------------------------------------------------------------------------
' If the search string is longer than the string to be parsed then leave
' -----------------------------------------------------------------------------
If lngDataLen < lngSearchLen Then
StrSearch = 0
Exit Function
End If
' -----------------------------------------------------------------------------
' Initiate a loop to search the data string
' -----------------------------------------------------------------------------
For lngIndex = 1 To lngDataLen
' Extract section of data equal to length of search string
strTest = Mid$(strData, lngIndex, lngSearchLen)
' Compare extracted data. If exact match is requested then do a
' binary compare; otherwise, do a text compare.
If blnMatchCase Then
If StrComp(strTest, strSearchFor, vbBinaryCompare) = 0 Then
lngLastPosition = lngIndex
lngCount = lngCount + 1
' if replace the data has been requested
If blnReplace Then
Mid$(strData, lngIndex, lngSearchLen) = strSearchFor
End If
End If
Else
If StrComp(strTest, strSearchFor, vbTextCompare) = 0 Then
lngLastPosition = lngIndex
lngCount = lngCount + 1
' if replace the data has been requested
If blnReplace Then
Mid$(strData, lngIndex, lngSearchLen) = strSearchFor
End If
End If
End If
' Save the position of the first occurance
If lngFirstPosition = 0 And lngCount > 0 Then
lngFirstPosition = lngIndex
End If
Next
' -----------------------------------------------------------------------------
' Return the results of the search
' -----------------------------------------------------------------------------
If blnCountOccurances Then
' Return number of occurances
StrSearch = lngCount
Else
' Position in string was requested
If blnLastOccurance Then
StrSearch = lngLastPosition ' last occurance found in string
Else
StrSearch = lngFirstPosition ' first occurance found in string
End If
End If
End Function
