Attribute VB_Name = "mod_Globals"
Option Explicit

Public iCount As Integer
Public iniValue As Variant
Public mouseH As Long
Public mouseX As Long
Public mouseY As Long
Public programDir As String
Public ThemeDir As String
Public ThemeName As String
Public InputBack As String
Public InputMode As Boolean
Public SoundBack As String
Public BackGroundSound As String
Public BackGroundMode As Boolean

Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function mciExecute& Lib "winmm.dll" (ByVal lpstrCommand As String)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function PlaySoundNow Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
   (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal _
   uReturnLength As Long, ByVal hwndCallback As Long) As Long


Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_HWNDPARENT = (-8)
Public Const SC_SCREENSAVE = &HF140&
Public Const SPI_GETWORKAREA = 48
Public Const SPI_SETWORKAREA = 47
Public Const SPIF_SENDCHANGE = &H2
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const WM_SYSCOMMAND = &H112&
Public Const WS_BORDER = &H800000
Public Const WS_EX_TOOLWINDOW = &H80
Public Const WS_VISIBLE = &H10000000
Public Const conHwndTopmost = -1
Public Const conSwpNoActivate = &H10
Public Const conSwpShowWindow = &H40

Public Const SND_ASYNC = &H1 'just after the beginning of the sound exit function
Public Const SND_LOOP = &H8 'repeat the sound until the function is called again
Public Const SND_ALOOP = &H9
Public Const SND_FILENAME = &H20000
Public Const SND_PURGE = &H40
Public Const SND_NODEFAULT = &H2


Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Function Check_Shareware() As String
    Dim userSkey As Long
    Dim userLkey As Long
    Dim userXkey As Long
    Dim Skey As String
    Dim Lkey As String
    Dim Xkey As String
    Dim Cname As String
    Dim CData As String
    Dim CNaam As String
    Dim I As Long
    Dim lngCdate As Long
    Dim lngSdate As Long
    Dim lngEdate As Long
    Dim sDate
    Dim dDate
    
    Skey = GetSetting("LCARS Terminal", "Default", "Skey", "1")
    Lkey = GetSetting("LCARS Terminal", "Default", "Lkey", "1")
    Xkey = GetSetting("LCARS Terminal", "Default", "Xkey", "1")
    CNaam = GetSetting("LCARS Terminal", "Default", "Name", "1")
    CData = GetSetting("LCARS Terminal", "Default", "Date", "20010101")
    Check_Shareware = ""
    lngCdate = Val(Format(Now, "yyyymmdd"))
    lngSdate = Val(CData)
    
    Cname = Mid(CData, 7, 2) & "-" & MonthName(CLng(Mid(CData, 5, 2))) & "-" & Left(CData, 4)
    sDate = CDate(Cname)
    dDate = DateAdd("m", 12, sDate)
    lngEdate = Val(Format(dDate, "yyyymmdd"))
    Cname = CData & CNaam
    
    If lngEdate >= 20050101 Then
    'If lngEdate >= 20040901 Then
        lngEdate = lngCdate
    End If
    
    'If Skey <> "1" And Lkey <> "1" And Xkey <> "1" And Cname <> "1" And CData <> "1" And lngCdate >= lngSdate And lngCdate <= lngEdate Then
    If Skey <> "1" And Lkey <> "1" And Xkey <> "1" And Cname <> "1" And CData <> "1" And lngCdate <= lngEdate Then
        userSkey = Len(Cname)
        For I = 1 To Len(Cname)
            If I < 9 Then
                userSkey = userSkey + Asc(Mid(Cname, I, 1))
            End If
        Next
        userLkey = userSkey
        For I = 1 To Len(Cname)
            userLkey = userLkey + (I * Asc(Mid(Cname, I, 1)))
        Next
        userXkey = userLkey
        For I = 1 To Len(Cname)
            userXkey = userXkey + (I * Asc(Mid(Cname, I, 1)))
            userXkey = userXkey + (I * 5 * Asc(Mid(Cname, I, 1)))
        Next
        If (Val(Skey) = userSkey And Val(Lkey) = userLkey And Val(Xkey) = userXkey) Then
            Check_Shareware = CNaam
        End If
    End If
End Function

Public Function GetSecurity(gsIndex As Integer) As Boolean
    Dim gsPos As Long
    Dim gsString As String
    
    GetSecurity = False
    If INI_GetKey("DEFAULT", Format(mySecurity(gsIndex), "00"), programDir & ThemeDir & Mid(ThemeName, 1, Len(ThemeName) - 3) & "ini") = True Then
        gsString = iniValue
        gsPos = InStr(gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsString = Mid(gsString, gsPos + 1)
        GetSecurity = Mid(gsString, 1, InStr(gsString, ",") - 1)
    ElseIf INI_GetKey("DEFAULT", Format(mySecurity(gsIndex), "00"), programDir & ThemeDir & ThemeName) = True Then
        gsString = iniValue
        gsPos = InStr(gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsPos = InStr(gsPos + 1, gsString, ",")
        gsString = Mid(gsString, gsPos + 1)
        GetSecurity = Mid(gsString, 1, InStr(gsString, ",") - 1)
    End If
End Function

Public Function GetShortName(ByVal sLongFileName As String) As String
    Dim lRetVal As Long, sShortPathName As String, iLen As Integer

    sShortPathName = Space(255)
    iLen = Len(sShortPathName)

    lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
    GetShortName = Left(sShortPathName, lRetVal)
End Function

Public Function INI_GetKey(SectionName As String, KeyName As String, IniFileName As String) As Boolean
    Dim ReturnString As String
    Dim ReturnValue As Long
    
    On Local Error GoTo GetKey_Err
    ReturnString = String$(32000, 0)
    iniValue = ""
    ReturnValue = GetPrivateProfileString(SectionName & Chr(0), KeyName, "NotFound", ReturnString, Len(ReturnString), IniFileName & Chr(0))
    If Left(ReturnString, InStr(ReturnString, Chr$(0)) - 1) = "NotFound" Then
        INI_GetKey = False
    Else
        INI_GetKey = True
        iniValue = Left(ReturnString, InStr(ReturnString, Chr$(0)) - 1)
    End If

GetKey_End:
    Exit Function

GetKey_Err:
    MsgBox "Error Retrieving Key"
    INI_GetKey = False
    Resume GetKey_End
End Function

Public Function IsToolWindow(ByVal hwnd As Long) As Boolean
   IsToolWindow = ((GetWindowLong(hwnd, GWL_EXSTYLE) And WS_EX_TOOLWINDOW) = WS_EX_TOOLWINDOW)
End Function

Public Sub Mouse_Get(myform As Form)
    Dim mouseco As POINTAPI
    Dim MouseI As Long
    Dim mouseJ As Long
    
    GetCursorPos mouseco
    mouseX = mouseco.X - (myform.Left \ Screen.TwipsPerPixelX)
    mouseY = mouseco.Y - (myform.Top \ Screen.TwipsPerPixelY)
    mouseH = WindowFromPoint(mouseco.X, mouseco.Y)
End Sub

Public Sub PlaySound(mySound As String, myWait As Boolean)
    Dim Variable
    Dim strSound As String
    Dim booSound As Boolean
    Dim booMultiple As Boolean
    Dim canPlay As Integer
    
    booSound = True
    On Error Resume Next
    If INI_GetKey("DEFAULT", "Sound", programDir & ThemeDir & "terminal.skn") = True Then
        booSound = iniValue
    End If
    If booSound = False Then Exit Sub
    
    booMultiple = False
    If INI_GetKey("DEFAULT", "Multiple", programDir & ThemeDir & "terminal.skn") = True Then
        booMultiple = iniValue
    End If
    
    canPlay = waveOutGetNumDevs
    If canPlay > 0 Then
    Else
        Exit Sub
    End If
    Variable = 0
    If InStr(mySound, ":") > 0 Then
        strSound = GetShortName(mySound)
    Else
        strSound = GetShortName(programDir & ThemeDir & mySound & ".wav")
    End If
    Variable = FileLen(strSound)
    If (Variable > 0) Then
        If myWait = True Then
            If booMultiple = True Then
                Variable = mciExecute("play " & strSound & " wait")
            Else
                Variable = PlaySoundNow(strSound, 1, 0)
            End If
        Else
            If booMultiple = True Then
                Variable = mciExecute("play " & strSound)
            Else
                Variable = PlaySoundNow(strSound, 1, SND_ASYNC)
            End If
        End If
    End If
End Sub

Public Sub PlayBackSound()
'ACHTUNG vergess nicht, dass der Dateiname im DOS-Format sein muss. Und hier die Funktionen:
'Zum öffnen der *.wav Datei:
'mciSendString "open " & Dateiname & " type MPEGVideo Alias wav", "", 0, 0
'
'zum Abspielen:
'mciSendString "play wav", "", 0, 0
'
'Zum Beenden & MCI "Gerät" wieder Freigeben:
'mciSendString "close wav", "", 0, 0
'
'zum Pausieren:
'mciSendString "stop wav", "", 0, 0
'
'zur Endloswiedergabe:
'mciSendString "play wav repeat", "", 0, 0
    Dim strSound As String
    'On Error Resume Next
    strSound = GetShortName(programDir & ThemeDir & BackGroundSound & ".wav")
    'rc = PlaySoundNow(strSound, 0, SND_ALOOP Or SND_NODEFAULT Or SND_FILENAME)
    mciSendString "open " & strSound & " type MPEGVideo alias backsound", "", 0, 0
    mciSendString "play backsound repeat", "", 0, 0
End Sub

Public Sub StopBackSound()
    'On Error Resume Next
    mciSendString "stop backsound", "", 0, 0
    mciSendString "close backsound", "", 0, 0
End Sub
