MultiUse = -1  'True

  Persistable = 0  'NotPersistable

  DataBindingBehavior = 0  'vbNone

  DataSourceBehavior = 0   'vbNone

  MTSTransactionMode = 0   'NotAnMTSObject

End

'-----------------------------

'Данный Cls файл был создан

'общими усилиями некоторых

'фидошников и мной в частности

'отредактирован Alesha Dzybalo

'alesha@ubuoik.kamaz.kazan.su

'-----------------------------

Option Explicit

Public RusLang As Boolean

Dim i As Integer

Dim fh As Integer



Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private 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

Private 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

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildWindow As Long, ByVal lpClassName As String, ByVal lpsWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long



Const WM_USER As Long = &H400

Const TB_SETSTYLE = WM_USER + 56

Const TB_GETSTYLE = WM_USER + 57

Const TBSTYLE_FLAT = &H800



'Изменяем обычный тулбар в Flat

Public Sub Flatbar(hwnd As Long)

    Dim lTBarStyle As Long, lTBarHwnd As Long

    lTBarHwnd = FindWindowEx(hwnd, 0&, "ToolbarWindow32", vbNullString)

    lTBarStyle = SendMessage(lTBarHwnd, TB_GETSTYLE, 0&, ByVal 0&)

    lTBarStyle = lTBarStyle Or TBSTYLE_FLAT

    SendMessage lTBarHwnd, TB_SETSTYLE, 0, ByVal lTBarStyle

End Sub



'Читаем данные из ini

Function ReadINIKey(Section As String, KeyName As String, FileName As String) As String

    Dim RetVal As String

    RetVal = String(255, Chr(0))

    ReadINIKey = Left(RetVal, GetPrivateProfileString(Section, KeyName, "", RetVal, Len(RetVal), FileName))

End Function



'Записываем данные в ini

Function WriteInIKey(Section As String, KeyName As String, KeyValue As String, FileName As String)

    WritePrivateProfileString Section, KeyName, KeyValue, FileName

End Function



'Проигрываем через MCI wav

Public Function Sound(FilePath As String)

    mciExecute "Play  " & FilePath

End Function



'Запустить експлорер

Public Function ShellProgramm(WebAdress As String)

    ShellProgramm = ShellExecute(0, "open", WebAdress, "", "", 1)

End Function



'XOR

Function CryptAndDecrypt(ByVal sString As String, key As Integer, Crypt As Integer) As Variant

    On Error Resume Next

    Dim i As Integer, sFinal As String

    If Crypt = 1 Then

     For i = 1 To Len(sString)

      sFinal = sFinal + Chr$(Asc(Mid$(sString, i, 1)) + key)

     Next i

    ElseIf Crypt = 2 Then

     For i = 1 To Len(sString)

      sFinal = sFinal + Chr$(Asc(Mid$(sString, i, 1)) - key)

     Next i

    End If

    CryptAndDecrypt = sFinal

    If Err.Number <> 0 Then

    Exit Function

    End If

End Function



'Отслеживаем нажатие клавиш (определенное слово)

Public Function SecretKey(KeyCode As Integer, SecretWord As String) As Boolean

    Dim i As Integer

    Dim LenText As Integer

    Static KeyPressFlg As String

    LenText = Len(SecretWord)

    For i = 1 To LenText

     If Chr(KeyCode) = Mid(SecretWord, i, 1) Then KeyPressFlg = KeyPressFlg + Chr(KeyCode)

    Next

    If Len(KeyPressFlg) > LenText Then KeyPressFlg = ""

    If CStr(KeyPressFlg) = CStr(SecretWord) Then SecretKey = True

End Function