appactivates.bas

机房管理

Attribute VB_Name = "MAppActivate"
  Option Explicit
  
  Public Type RECT
    left As Long
    tOp As Long
    Right As Long
    Bottom As Long
  End Type

  Public Const SW_RESTORE As Long = 9&

  Public Const GW_CHILD As Long = 5&
  Public Const GW_HWNDNEXT As Long = 2&
  
  Public Declare Function GetDesktopWindow& Lib "user32" ()
  
  Public Declare Function GetWindow& Lib "user32" (ByVal hwnd&, ByVal wCmd&)

  Public Declare Function GetWindowText& Lib "user32" Alias "GetWindowTextA" _
                                    (ByVal hwnd&, ByVal lpString$, ByVal cch&)
  
  Public Declare Function ShowWindow& Lib "user32" (ByVal hwnd&, ByVal nCmdShow&)

  Public Declare Function GetWindowRect& Lib "user32" (ByVal hwnd&, lpRect As RECT)

  Public Declare Function MoveWindow& Lib "user32" (ByVal hwnd&, ByVal x&, _
                          ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal bRepaint&)

  Public Declare Function SetForegroundWindow& Lib "user32" (ByVal hwnd&)
  
  Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
                                          (ByVal lpClassName$, ByVal lpWindowName$)

Private Sub Main()

  Const sBaseCaption As String = "Service"
  
  If App.PrevInstance = True Then
      
      Dim hAppWindow&, sTemp$
      hAppWindow = GetWindow(GetDesktopWindow(), GW_CHILD)
      
      Do
        sTemp = String$(180, False)
        Call GetWindowText(hAppWindow, sTemp, 179)
  
        If InStr(sTemp, sBaseCaption) Then
        
           ActivatePrevInstance (hAppWindow) '使以前的窗口活动

          Exit Do
        End If
  
        ' 获得下一个子窗体
        hAppWindow = GetWindow(hAppWindow, GW_HWNDNEXT)
      Loop

  Else
  
    'ConStr = "ODBC;DSN=NetBarServer;UID=;PWD=NetBarServer"
    ConStr = ";UID=;PWD=NetBarServer"
    
    checkPath ""                  '检测路径
    
    '第一次运行时
    'frmServer.Show
     frmSplash.Show
  End If

End Sub

Public Sub ActivatePrevInstance(ByVal hAppWindow&)

  Call ShowWindow(hAppWindow, SW_RESTORE)

  '使窗口活动
  Call SetForegroundWindow(hAppWindow)
  
  
End Sub

Public Sub checkPath(strCorrect As String)

Dim FS As String, Fn As Long
 If strCorrect = "" Then
    FS = GetSetting(App.EXEName, "Data", "Path")
   Else
    FS = strCorrect
 End If
    Fn = FreeFile
On Error GoTo Exist_Err
Open FS For Input As #Fn
Close #Fn
  ConData = FS
  SaveSetting App.EXEName, "Data", "Path", ConData
  'ConData = ""   'ODBC数据源
  
Exit Sub

Exist_Err:

  MsgBox vbCrLf & "网 络 路 径 错 误 , 现 在 启 用 本 地 数 据 库 。        " + vbCrLf + vbCrLf + "如 果 需 要 , 请 重 新 定 义 网 络 数 据 库 的 路 径  ！    ", vbOKOnly + vbExclamation, "网络路径错误"
    
  ConData = App.Path + "\data.Mdb"
  SaveSetting App.EXEName, "Data", "Path", ConData
   
End Sub