[_]
[1]
[2]
[3]
[4]
[5]
[6]
[7]
[8]
[9]
[10]
[11]
[12]
[13]
[14]
[15]
[16]
[17]
[18]
[19]
[20]
[21]
[22]
[23]
Универсальный класс, который позволяет изменять вид тулбара, читать данные из
*.ini и записывать в него, проигрывать wav, запускать IE с web-адресом, отслеживать
ввод с клавиатуры определенного слова. Для создания *.dll исходный код полностью
вставляется в открытый проект ActiveX и компилируется.
MultiUse = -1 'Truee
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
<<<Назад
|
