home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Server_Key3610311192001.psc / frmControl.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-11-16  |  3.3 KB  |  86 lines
  1. VERSION 5.00
  2. Begin VB.Form frmControl 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Control Panel"
  5.    ClientHeight    =   1935
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   1845
  9.    LinkTopic       =   "Form2"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   1935
  13.    ScaleWidth      =   1845
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.CommandButton Command1 
  16.       Caption         =   "Application"
  17.       Height          =   495
  18.       Left            =   120
  19.       TabIndex        =   2
  20.       Top             =   720
  21.       Width           =   1575
  22.    End
  23.    Begin VB.CommandButton cmdCreate 
  24.       Caption         =   "Create Key"
  25.       Height          =   495
  26.       Left            =   120
  27.       TabIndex        =   1
  28.       Top             =   1320
  29.       Width           =   1575
  30.    End
  31.    Begin VB.CommandButton cmdServer 
  32.       Caption         =   "Server"
  33.       Height          =   495
  34.       Left            =   120
  35.       TabIndex        =   0
  36.       Top             =   120
  37.       Width           =   1575
  38.    End
  39. Attribute VB_Name = "frmControl"
  40. Attribute VB_GlobalNameSpace = False
  41. Attribute VB_Creatable = False
  42. Attribute VB_PredeclaredId = True
  43. Attribute VB_Exposed = False
  44. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  45. Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
  46. Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  47. Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
  48. Private Sub cmdCreate_Click()
  49.     frmCreateKey.Show
  50. End Sub
  51. Private Sub cmdServer_Click()
  52.     'check to see if any other copy of the server program is running
  53.     'as this would be a way to use the same licence file over and over again in
  54.     'different directories on the same machine
  55.     Dim lhWnd As Long
  56.     lhWnd = FindAnyWindow(Me, "Server Licence Administrator")
  57.     If lhWnd <> 0 Then ' 0 means Server not running.
  58.         MsgBox "Server is already running on this machine!", vbExclamation + vbOKOnly, "Error"
  59.         Unload Me
  60.         Exit Sub
  61.     End If
  62.     frmServer.Show
  63. End Sub
  64. Private Sub Command1_Click()
  65.     frmApp.Show
  66. End Sub
  67. Private Function GetCaption(ByVal lhWnd As Long) As String
  68.     Dim sA As String, lLen As Long
  69.     lLen& = GetWindowTextLength(lhWnd&)
  70.     sA$ = String(lLen&, 0&)
  71.     Call GetWindowText(lhWnd&, sA$, lLen& + 1)
  72.     GetCaption$ = sA$
  73. End Function
  74. Private Function FindAnyWindow(frm As Form, ByVal WinTitle As String, Optional ByVal CaseSensitive As Boolean = False) As Long
  75.     Dim lhWnd As Long, sA As String
  76.     lhWnd& = frm.hwnd
  77.     Do Until lhWnd& = 0
  78.         DoEvents
  79.             
  80.             sA$ = GetCaption(lhWnd&)
  81.             If InStr(IIf(CaseSensitive = False, LCase$(sA$), sA$), IIf(CaseSensitive = False, LCase$(WinTitle$), WinTitle$)) Then FindAnyWindow& = lhWnd&: Exit Do Else FindAnyWindow& = 0
  82.             
  83.             lhWnd& = GetNextWindow(lhWnd&, 2)
  84.     Loop
  85. End Function
  86.