Programming Tool Box/SIMS_2.iso/bp_6_93/vbwin/tricks/4_94.frm

Text File | 1995-02-26 | 6KB | 211 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   5304
   ClientLeft      =   1860
   ClientTop       =   1620
   ClientWidth     =   7176
   Height          =   5724
   Icon            =   4_94.FRX:0000
   Left            =   1812
   LinkTopic       =   "Form1"
   ScaleHeight     =   5304
   ScaleWidth      =   7176
   Top             =   1248
   Width           =   7272
   Begin CheckBox Check1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Nur anzeigen"
      Height          =   372
      Left            =   4140
      TabIndex        =   7
      Top             =   1080
      Width           =   2892
   End
   Begin TextBox Text1
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   432
      Left            =   4140
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   540
      Width           =   2892
   End
   Begin CommandButton com
      Caption         =   "&Ende"
      Height          =   672
      Index           =   3
      Left            =   4140
      TabIndex        =   5
      Top             =   4380
      Width           =   2112
   End
   Begin CommandButton com
      Caption         =   "Rechner &booten"
      Height          =   672
      Index           =   2
      Left            =   360
      TabIndex        =   3
      Top             =   4380
      Width           =   2112
   End
   Begin CommandButton com
      Caption         =   "Windows &Neustart"
      Height          =   672
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   3540
      Width           =   2112
   End
   Begin CommandButton com
      Caption         =   "Windows &beenden"
      Height          =   672
      Index           =   0
      Left            =   360
      TabIndex        =   1
      Top             =   2700
      Width           =   2112
   End
   Begin Label lbl_mod
      BackColor       =   &H00C0C0C0&
      Height          =   732
      Left            =   360
      TabIndex        =   4
      Top             =   1080
      Width           =   3432
   End
   Begin Label lbl_ver
      BackColor       =   &H00C0C0C0&
      Height          =   312
      Left            =   360
      TabIndex        =   0
      Top             =   600
      Width           =   3432
   End
End
'korrekte Windows-Version
Declare Function GetFileVersionInfo% Lib "VER.DLL" (ByVal lpszFileName$, ByVal lpdwHandle&, ByVal cbbuf&, ByVal lpvdata$)

'Windows beenden
Declare Function ExitWindows% Lib "User" (ByVal dwReserved&, ByVal wReturnCode%)
Const EW_REBOOTSYSTEM = &H43
Const EW_RESTARTWINDOWS = &H42

'Entwicklungsumgebung oder EXE?
Declare Function GetClassName% Lib "User" (ByVal hWnd%, ByVal lpClassName$, ByVal nMaxCount%)
Declare Function GetWindowWord% Lib "User" (ByVal hWnd%, ByVal nIndex%)
Const GWW_HWNDPARENT = (-8)

'ben÷tigte Funktionen fⁿr Test ob Programm schon lΣuft
Declare Function FindWindow% Lib "user" (ByVal lpClassName As Any, ByVal lpCaption As Any)
Declare Function ShowWindow% Lib "User" (ByVal Handle As Integer, ByVal Cmd As Integer)
Declare Function SFocus% Lib "User" Alias "SetFocus" (ByVal Handle As Integer)

'textboxen
Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
Const WM_USER = &H400
Const EM_SETREADONLY = (WM_USER + 31)
Const EM_LIMITTEXT = (WM_USER + 21)

Sub Check1_Click ()

    If check1.Value = 0 Then
    X& = SendMessage&(text1.hWnd, EM_SETREADONLY, False, 0)
    Else
    X& = SendMessage&(text1.hWnd, EM_SETREADONLY, True, 0)
    End If

End Sub

Sub com_Click (Index As Integer)

    Select Case Index
    Case 0 'Win beenden
    Modus& = 0
    Case 1 'Win Neustart
    Modus& = EW_RESTARTWINDOWS
    Case 2 'Rechner booten
    Modus& = EW_REBOOTSYSTEM
    Case 3 'Programmende
    End
    End Select

    kr% = ExitWindows%(Modus&, 0)

    If kr% = False Then
    MsgBox "Windows kann nicht beendet werden", 16, "Artikel 4/94 (KR)"
    End If


End Sub

Function Entwicklung% ()

    parent% = GetWindowWord%(hWnd, GWW_HWNDPARENT)
    class$ = Space$(32)
    kr% = GetClassName%(parent%, class$, 31)
    class$ = Left$(class$, kr%)
    If InStr(class$, "RT") Then
    Entwicklung% = False
    Else
    Entwicklung% = True
    End If

End Function

Sub Form_Load ()

    Me.Caption = ""
    Titel$ = "Artikel BP 4/94         Klaus Rambow"
    kr% = SchonGestartet(Titel$)
    If kr% = True Then
    End
    End If
    Me.Caption = Titel$


    'Windows-Version
    lbl_ver.Caption = "Windows-Version: " & Win_Version()

    'Entwicklungumgebung oder EXE?
    If Entwicklung%() Then
    Modus$ = " in der Entwicklungumgebung."
    Else
    Modus$ = " als EXE."
    End If
    lbl_mod.Caption = "Die Anwendung lΣuft " & Modus$

End Sub

Function SchonGestartet (Form As String) As Integer

    'Dim Handle As Integer
    Handle% = FindWindow(0&, Form)
    If Handle% = 0 Then
    SchonGestartet = False
    Else
    X% = ShowWindow(Handle%, 1)
    X% = SFocus(Handle%)
    SchonGestartet = True
    End If

End Function

Function Win_Version ()

    Dim Version As String * 255
    Version = Space$(255)
    kr% = GetFileVersionInfo("user.exe", 0&, 254, Version)
    X = InStr(1, Version, "FileVersion")
    antw = Mid$(Version, X + 12, 4)
    Win_Version = antw

End Function