Класс с универсальным набором функций

  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