basmain.bas

程序加密算法

  Load frmOptions
  Load frmRnd
  Load frmTestPWD
  Load frmMainMenu
  
End Sub

Public Sub TerminateApplication()

' ***************************************************************************
' Routine:       TerminateApplication
'
' Description:   This routine will performt he shutdown process for this
'                application.  If there are any global object/class (not
'                forms) they will be listed below and set to NOTHING so as
'                to free them from memory.  The last task is to unload
'                all form objects.  Then terminate this application.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Set all global objects to nothing, if they were used in this application
' EXAMPLE:    Set g_objMyObj = Nothing
' ---------------------------------------------------------------------------

' ---------------------------------------------------------------------------
' Upload all forms from memory and terminate this application
' ---------------------------------------------------------------------------
  CloseOpenFiles
  UnloadAllForms
  End
  
End Sub

Public Function CloseOpenFiles() As Boolean
  
' ---------------------------------------------------------------------------
' Closes any files that were opened with an "Open" statement
' ---------------------------------------------------------------------------
  While FreeFile > 1
      Close #FreeFile - 1
  Wend

End Function

Private Sub UnloadAllForms()

' ***************************************************************************
' Routine:       TerminateApplication
'
' Description:   Unload all active forms associated with this application.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim frm As Form
  
' ---------------------------------------------------------------------------
' Loop thru all the active forms associated with this application
' ---------------------------------------------------------------------------
  For Each frm In Forms
      frm.Hide            ' hide the form
      Unload frm          ' deactivate the form
      Set frm = Nothing   ' free form object from memory
                          ' (prevents memory fragmenting)
  Next
  
End Sub

Public Function AlreadyRunning(strAppTitle As String) As Boolean

' ***************************************************************************
' Routine:       AlreadyRunning
'
' Description:   This routine will set an external search flag to FALSE and
'                perform an enumeration of all active programs, either hidden,
'                minimized, or displayed.
'
' Parameters:    strAppTitle - partial/full name of application title to
'                              look for
'
' Returns:       TRUE/FALSE based on the findings.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngRetCode As Long

' ---------------------------------------------------------------------------
' Intialize variables
' ---------------------------------------------------------------------------
  m_blnFoundApp = False
  m_intAppCount = 0

' ---------------------------------------------------------------------------
' Search all active applicatios to see if this one is already running
' ---------------------------------------------------------------------------
  m_strTargetTitle = StrConv(strAppTitle, vbLowerCase)
  Call EnumWindows(AddressOf FindApplication, &H0)

' ---------------------------------------------------------------------------
' Return TRUE/FALSE based on findings
' ---------------------------------------------------------------------------
  AlreadyRunning = m_blnFoundApp
  
End Function

Private Function FindApplication(ByVal lngHandle As Long, _
                                 Optional ByVal lngParam As Long = 0) As Long

' ***************************************************************************
' Routine:       FindApplication
'
' Description:   This routine will search ALL active programs running under
'                Windows, including the hidden and minimized.  It will
'                look for the parent name.  The partial/full title name will
'                will be used for the search pattern.
'
' Parameters:    lngHandle - Generic application handle to check all active
'                       programs
'                lngParam - Not used (but required for callbacks)
'
' Returns:       Sets an external flag to TRUE/FALSE based on the findings.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim lngLength     As Long    ' Length of the title string
  Dim strClassName  As String  ' Class name after formatting
  Dim strAppTitle   As String  ' Parent title after formatting

' ---------------------------------------------------------------------------
' Initialize return areas with spaces
' ---------------------------------------------------------------------------
  strClassName = Space$(MAX_PATH)
  strAppTitle = Space$(MAX_PATH)
   
' ---------------------------------------------------------------------------
' Make API calls to get the class name
' ---------------------------------------------------------------------------
  Call GetClassName(lngHandle, strClassName, MAX_PATH)
  strClassName = Trim$(Left$(strClassName, Len(PGM_CLASS)))
  
' ---------------------------------------------------------------------------
' Make API calls to get the parent title.  Capture just the left portion for
' the exact number of characters as the search title.  We want an exact
' match on the name.
' ---------------------------------------------------------------------------
  lngLength = GetWindowText(lngHandle, strAppTitle, MAX_PATH)
  strAppTitle = StrConv(Left$(strAppTitle, lngLength), vbLowerCase)
  strAppTitle = LTrim$(strAppTitle)  ' remove all leading blanks
  
' ---------------------------------------------------------------------------
' See if the class name matches.  If it does then check the parent title.
' ---------------------------------------------------------------------------
  If StrComp(strClassName, PGM_CLASS, vbTextCompare) = 0 Then
             
      ' See if this is the right title. Since we may only have a
      ' partial title, then we have to do an Instr() compare.
      ' This is why we want to make sure that the search title is
      ' as unique as possible.
      If InStr(1, strAppTitle, m_strTargetTitle, vbTextCompare) > 0 Then
                
          ' increment the counter.
          m_intAppCount = m_intAppCount + 1
          
          ' If we find more than one occurance of this program
          ' then set the flag to TRUE and leave
          If m_intAppCount > 1 Then
              ' set the flag denoting that we have found a duplicate
              m_blnFoundApp = True
              Exit Function        ' Time to leave
          End If
      End If
  End If
  
' ---------------------------------------------------------------------------
' Continue searching.
' ---------------------------------------------------------------------------
  Call CloseHandle(lngHandle)      ' close the active handle
  FindApplication = 1              ' Set the flag for another interation

End Function