Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Как установить хук на изменение...-> Добавлено: 20.08.04 13:40  

Автор вопроса:   j3d1 | ICQ: 8370005 
сабж + значений в заданном адреснном пространстве, т.е если в какой-то порт записали битик програ должна отловить это событие.
 ЗЫ. циклы и таймеры не предлогать :)

Ответить

  Ответы Всего ответов: 21  

Номер ответа: 1
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #1 		Добавлено: 20.08.04 13:55
Этого, кажется, и винда не умеет...

Я еще ни одной тулзы такой не видел, да и представить себе это сложно...

Ответить

Номер ответа: 2
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #2 Добавлено: 20.08.04 14:10
WinLirc - это делает

Ответить

Номер ответа: 3
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #3 Добавлено: 20.08.04 14:10
^^^ИМХО^^^

Ответить

Номер ответа: 4
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
  Web-сайт: basicproduction.nm.ru
 Профиль | | #4 		Добавлено: 20.08.04 15:46
 А может с этим WinLirc драйвер какой идёт? Перехват прерываний возможен(в ДОС-е), а API такой по моему нет.

Ответить

Номер ответа: 5
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #5 		Добавлено: 20.08.04 17:55
WinLirc, это в каком это месте он это делает ??? Он крутит в отдельном потоке, чтение данных из порта... А эта АПИ не передает управления потоку до тех пор, пока не получит данных...

Т.ч. по-моему, ты не прав!

Ответить

Номер ответа: 6
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #6 		Добавлено: 20.08.04 18:42
Ах, да, а если ты имеешь ввиду связь между сервером (цштдшкс) и клиентами (программы), дык они используют TCP протокол для передаи данных, и за всем этим делом следит уже WinSock.dll

Ответить

Номер ответа: 7
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
  Профиль | | #7 Добавлено: 21.08.04 02:36
У меня есть пример для хардварной работы с портами (я не проверял), взят с planet-source.com
Есть функции чтения-записи
Но возможно это не те порты о которых идет речь (может это даже LTP :) ), но если надо я на мыло скину

Ответить

Номер ответа: 8
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #8 Добавлено: 21.08.04 12:26
Там цикл , но там стоит евент по которому он хавает риквесты

//6
 это не интересно

Ответить

Номер ответа: 9
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #9 Добавлено: 21.08.04 12:45
//4 Драйверов нету, смотрел, юзает только виндузные библиотеки, хотя у меня была идея написать драйвер. :)


Была идея использовать COM как файл, но, обломно, он не возвращаят CD,DSR,CTS,DTR,RTS.
Именно эти значения нужны в тот момент когда одно из них изменяется.
есть такая API ф-я WaitCommEvent, но она ни чего не ждёт. Делал евент(CreateEvent(...)) потом ждал ф-ей WaitForSingeObject(...),но опять же галяк, она вешает всё.
 буду дальше разбиратся

Ответить

Номер ответа: 10
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #10 Добавлено: 22.08.04 10:05
Всем 10х я нашёл что искал .

Ответить

Номер ответа: 11
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #11 		Добавлено: 22.08.04 12:36
а поделиться :) ??

Ответить

Номер ответа: 12
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #12 Добавлено: 23.08.04 13:34
как допишу так сразу, вобще могу дать полу работающую она за ком портом следить не отрываясь :)

Ответить

Номер ответа: 13
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #13 		Добавлено: 23.08.04 14:49
давай полуработающую, заинтриговал ты меня :) интересно %)

Ответить

Номер ответа: 14
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #14 Добавлено: 24.08.04 11:32
Вобщем вот :)

''- Это объявы их надо поместить в модль с названием COM

 Option Explicit
Public Const EV_BREAK = &H40 ' BREAK received
Public Const EV_CTS = &H8 ' CTS changed state
Public Const EV_DSR = &H10 ' DSR changed state
Public Const EV_ERR = &H80 ' Line status error occurred
Public Const EV_EVENT1 = &H800 ' Provider specific event 1
Public Const EV_EVENT2 = &H1000 ' Provider specific event 2
Public Const EV_PERR = &H200 ' Printer error occured
Public Const EV_RING = &H100 ' Ring signal detected
Public Const EV_RLSD = &H20 ' RLSD changed state
Public Const EV_RX80FULL = &H400 ' Receive buffer is 80 percent full
Public Const EV_RXCHAR = &H1 ' Any Character received
Public Const EV_RXFLAG = &H2 ' Received certain character
Public Const EV_TXEMPTY = &H4 ' Transmitt Queue Empty
Public Const EVENPARITY = 2
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const OPEN_EXISTING = 3
Public Const FILE_FLAG_OVERLAPPED = &H40000000
Public Const INFINITE = &HFFFF ' Infinite timeout
Public Const ERROR_IO_PENDING = 997 ' dderror
Public Const WAIT_OBJECT_0 = &H0
Public Const WAIT_TIMEOUT = 258
Public Const DTR_CONTROL_DISABLE = &H0
Public Const DTR_CONTROL_ENABLE = &H1
Public Const DTR_CONTROL_HANDSHAKE = &H2
Public Const RTS_CONTROL_DISABLE = &H0
Public Const RTS_CONTROL_ENABLE = &H1
Public Const RTS_CONTROL_HANDSHAKE = &H2
Public Const RTS_CONTROL_TOGGLE = &H3
Public Const MS_RLSD_ON = &H80&
Public Const PURGE_RXABORT = &H2 ' Kill the pending/current reads to the comm port.
Public Const PURGE_RXCLEAR = &H8 ' Kill the typeahead buffer if there.
Public Const PURGE_TXABORT = &H1 ' Kill the pending/current writes to the comm port.
Public Const PURGE_TXCLEAR = &H4 ' Kill the transmit queue if there.

Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

Type DCB__
        ;DCBLength As Long
        BaudRate As Long
        fBitFields As Long 'See Comments in Win32API.Txt
        wReserved As Integer
        XonLim As Integer
        XoffLim As Integer
        ByteSize As Byte
        Parity As Byte
        StopBits As Byte
        XonChar As Byte
        XoffChar As Byte
        ErrorChar As Byte
        EofChar As Byte
        EvtChar As Byte
        wReserved1 As Integer 'Reserved; Do Not Use
End Type
Public Type DCB
   ;DCBLength As Long ' DWORD DCBlength; /* sizeof(DCB) */
   BaudRate As Long ' DWORD BaudRate; /* Baudrate at which running */
   fBinary As Long ' DWORD fBinary: 1; /* Binary Mode (skip EOF check) */
   fPariti As Long ' DWORD fParity: 1; /* Enable parity checking */
   fOutxCtsFlow As Long ' DWORD fOutxCtsFlow:1; /* CTS handshaking on output */
   fOutxDsrFlow As Long ' DWORD fOutxDsrFlow:1; /* DSR handshaking on output */
   fDtrControl As Long ' DWORD fDtrControl:2; /* DTR Flow control */
   fDsrSensiviti As Long ' DWORD fDsrSensitivity:1; /* DSR Sensitivity */
   fDsrContinueOnXoff As Long ' DWORD fTXContinueOnXoff: 1; /* Continue TX when Xoff sent */
   fOutx As Long ' DWORD fOutX: 1; /* Enable output X-ON/X-OFF */
   finX As Long ' DWORD fInX: 1; /* Enable input X-ON/X-OFF */
   fErrorChar As Long ' DWORD fErrorChar: 1; /* Enable Err Replacement */
   fNull As Long ' DWORD fNull: 1; /* Enable Null stripping */
   fRtsControl As Long ' DWORD fRtsControl:2; /* Rts Flow control */
   fAbortOnError As Long ' DWORD fAbortOnError:1; /* Abort all reads and writes on Error */
   fDummy As Long ' DWORD fDummy2:17; /* Reserved */
   wReserved As Integer ' WORD wReserved; /* Not currently used */
   XonLim As Integer ' WORD XonLim; /* Transmit X-ON threshold */
   XoffLim As Integer ' WORD XoffLim; /* Transmit X-OFF threshold */
   ByteSize As Byte ' BYTE ByteSize; /* Number of bits/byte, 4-8 */
   Parity As Byte ' BYTE Parity; /* 0-4=None,Odd,Even,Mark,Space */
   StopBits As Byte ' BYTE StopBits; /* 0,1,2 = 1, 1.5, 2 */
   XonChar As Byte ' char XonChar; /* Tx and Rx X-ON character */
   XoffChar As Byte ' char XoffChar; /* Tx and Rx X-OFF character */
   ErrorChar As Byte ' char ErrorChar; /* Error replacement char */
   EofChar As Byte ' char EofChar; /* End of Input character */
   EvtChar As Byte ' char EvtChar; /* Received Event character */
   wReserved1 As Integer ' WORD wReserved1; /* Fill for now. */
End Type



Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type
Type COMMCONFIG
    dwSize As Long
    wVersion As Integer
    wReserved As Integer
    dcbx As DCB
    dwProviderSubType As Long
    dwProviderOffset As Long
    dwProviderSize As Long
    wcProviderData As Byte
End Type
Type COMMPROP
        wPacketLength As Integer
        wPacketVersion As Integer
        dwServiceMask As Long
        dwReserved1 As Long
        dwMaxTxQueue As Long
        dwMaxRxQueue As Long
        dwMaxBaud As Long
        dwProvSubType As Long
        dwProvCapabilities As Long
        dwSettableParams As Long
        dwSettableBaud As Long
        wSettableData As Integer
        wSettableStopParity As Integer
        dwCurrentTxQueue As Long
        dwCurrentRxQueue As Long
        dwProvSpec1 As Long
        dwProvSpec2 As Long
        wcProvChar(1) As Integer
End Type
Type COMMTIMEOUTS
        ReadIntervalTimeout As Long
        ReadTotalTimeoutMultiplier As Long
        ReadTotalTimeoutConstant As Long
        WriteTotalTimeoutMultiplier As Long
        WriteTotalTimeoutConstant As Long
End Type


Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Declare Function PurgeComm Lib "kernel32" (ByVal hFile As Long, ByVal dwFlags As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As Any, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Declare Function WaitCommEvent Lib "kernel32" (ByVal hFile As Long, lpEvtMask As Long, lpOverlapped As OVERLAPPED) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Declare Function GetCommConfig Lib "kernel32" (ByVal hCommDev As Long, lpCC As COMMCONFIG, lpdwSize As Long) As Long
Declare Function GetCommMask Lib "kernel32" (ByVal hFile As Long, lpEvtMask As Long) As Long
Declare Function GetCommModemStatus Lib "kernel32" (ByVal hFile As Long, lpModemStat As Long) As Long
Declare Function GetCommProperties Lib "kernel32" (ByVal hFile As Long, lpCommProp As COMMPROP) As Long
Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCB) As Long
Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function SetCommBreak Lib "kernel32" (ByVal nCid As Long) As Long
Declare Function SetCommConfig Lib "kernel32" (ByVal hCommDev As Long, lpCC As COMMCONFIG, ByVal dwSize As Long) As Long
Declare Function SetCommMask Lib "kernel32" (ByVal hFile As Long, ByVal dwEvtMask As Long) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function GetOverlappedResult Lib "kernel32" (ByVal hFile As Long, lpOverlapped As OVERLAPPED, lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount As Long, lpHandles As Any, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long



-- тута функйии тоже в модуль (можно в другой)

Option Explicit
Public Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function WaitH Lib "wo.dll" (ByVal hdl1 As Long, ByVal hdl2 As Long) As Integer
Declare Function SetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public tmp$, hCom As Long
Public dcb_ As DCB, lpsec As SECURITY_ATTRIBUTES
Public sync As OVERLAPPED, THR As New Threading, hTHR As Long
Public pg As Long, mas(1) As Long
Public cIt As Boolean
Function DEBUGW(str As String)
 Open App.Path & "\debug.txt" For Append As #1
  Print #1, str
 Close #1
End Function


Public Function ReadCom()
Dim prev As Long, state As Long, TK As Long
Dim HDL(2) As Long, res As Long
Const dat = &H1000000
Dim snt As Long, scnt As Long, CNT As Long
Sleep 1000

 HDL(1) = sync.hEvent: HDL(2) = hTHR
 ;Dim DevType As Long, sens As Long
 Call GetCommModemStatus(hCom, state)
   prev = state And MS_RLSD_ON
 Call GetCommModemStatus(hCom, sens)
 
   ;Dim pg1 As Boolean
   pg1 = False
   pg = 1

 ;Do

   ;DevType = EV_RLSD
   If SetCommMask(hCom, DevType) = 0 Then
    ' DEBUGW "SetCommMask ret 0 "
   End If
   ResetEvent sync.hEvent
      ;Dim evnt As Long
    Call WaitCommEvent(hCom, evnt, sync)
    
   TK = GetTickCount
   res = WaitForMultipleObjects(1, HDL(1), False, INFINITE)

   t_Start = LInt2Cur(t__Start)
   
   GetCommModemStatus hCom, state
   
   'deltv=(int)(((hr_time-hr_lasttime)*1000000) / hr_freq)
      ;Dim ddt As Double
   ;Dim dtime As Long
   
   If GetTickCount - TK > 15 Then
   
     MsgBox CNT & " пришло пакетов"
     snt = 0: scnt = 0: CNT = 0: tmp = Empty:
  End If

   


    CNT = CNT + 1
   'PurgeComm hCom, PURGE_RXCLEAR
 Loop
End Function

Function COMINIT(lpcom As String, prop As String) As Long
Dim hc As Long
 hc = COM.CreateFile(lpcom, GENERIC_READ Or _
 GENERIC_WRITE, 0, lpsec, OPEN_EXISTING, _
 FILE_FLAG_OVERLAPPED, 0)
 
 If hc <= 0 Then MsgBox "Ошибка открытия порта, возможно уже юзают", vbOKOnly + vbCritical, "COM_PORT": GoTo 10
 
 dcb_.DCBLength = Len(dcb_)
 dcb_.fDtrControl = DTR_CONTROL_ENABLE
 dcb_.fRtsControl = RTS_CONTROL_ENABLE
 COM.BuildCommDCB prop, dcb_
 If COM.SetCommState(hc, dcb_) Then
  ;DEBUGW "SetCommState _ init OK "
 Else
  ;DEBUGW "SetCommState _ Failed"
 End If
 ;DoEvents
 Sleep 1000
 sync.hEvent = CreateEvent(0, True, False, 0)
 If sync.hEvent <> 0 Then
   ;DEBUGW "Sync.hEvent = " & sync.hEvent & " _ INIT OK"
 Else
  ;DEBUGW "Sync.hEvent _ Failed"
  End
 End If
  
  
10:
 COMINIT = hc
End Function

Function StartCOMM()
  ;DEBUGW "--------- init " & Time & " " & Date & " ------------"
 ;Dim buf As String * 50 ', lpConf As COMMCONFIG
   
 hCom = COMINIT("COM2", "115000,n,8,2";)
DEBUGW "hCom = " & hCom
 ;DoEvents
Call THR.CreateNewThread(AddressOf ReadCom)
End Function



'----------------------------------------
' НИжнее надо запихнуть в класс
' Name - Threading
'----------------------------------------
'Creates a new thread
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
'Terminates a thread
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
'Sets the priority of a thread
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
'Returns the proirity of a thread
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
'Enables a disabled Thread
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
'Disables a thread
Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
'Returns the handle of the current thread
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
'Returns the ID of the current thread
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Consts
Private Const MAXLONG = &H7FFFFFFF

'Thread priority consts
Private Const THREAD_BASE_PRIORITY_IDLE = -15
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
Private Const THREAD_BASE_PRIORITY_MAX = 2
Private Const THREAD_BASE_PRIORITY_MIN = -2
Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT

'Thread creation flags
Private Const CREATE_ALWAYS = 2
Private Const CREATE_NEW = 1
Private Const CREATE_NEW_CONSOLE = &H10
Private Const CREATE_NEW_PROCESS_GROUP = &H200
Private Const CREATE_NO_WINDOW = &H8000000
Private Const CREATE_PROCESS_DEBUG_EVENT = 3
Private Const CREATE_SUSPENDED = &H4
Private Const CREATE_THREAD_DEBUG_EVENT = 2

'Types and Enums
Public Enum ThreadPriority
    tpLowest = THREAD_PRIORITY_LOWEST
    tpBelowNormal = THREAD_PRIORITY_BELOW_NORMAL
    tpNormal = THREAD_PRIORITY_NORMAL
    tpAboveNormal = THREAD_PRIORITY_ABOVE_NORMAL
    tpHighest = THREAD_PRIORITY_HIGHEST
End Enum

'Vars
Private mThreadHandle As Long
Private mThreadID As Long
Private mPriority As Long
Private mEnabled As Boolean
Private mCreated As Boolean

Public Function CreateNewThread(ByVal cFunction As Long, Optional ByVal cPriority As Long = tpNormal, Optional ByVal cEnabled As Boolean = True) As Long
    ;Dim mHandle As Long
    ;Dim CreationFlags As Long
    ;Dim lpThreadID As Long
    
    If mCreated = True Then Exit Function
    If cEnabled = True Then
        CreationFlags = 0
    Else
        'Create a disabled thread, can be enabled later with the
        ''Enabled' property
        CreationFlags = CREATE_SUSPENDED
    End If
    
    'The CreateThread Function returns the handle of the created thread;
    'if the handle is 0, it failed creating the thread
    mHandle = CreateThread(ByVal 0&, ByVal 0&, cFunction, ByVal 0&, CreationFlags, lpThreadID)
    
    If mHandle = 0 Then 'Failed creating the thread
        'Insert your own error handling
        'Debug.Print "InitializeThread Function in clsThreading failed creating a new thread"
    Else
        mThreadHandle = mHandle
        CreateNewThread = mHandle
        mThreadID = lpThreadID
        mCreated = True
    End If
End Function
Public Function TerminateCurrentThread()
    On Error Resume Next
    Call TerminateThread(mThreadHandle, ByVal 0&;)
    mCreated = False
End Function

Public Property Get ThreadHandle() As Long
    'Returns the Handle of the current Thread
    ThreadHandle = mThreadHandle
End Property

Public Property Get ThreadID() As Long
    'Returns the ID of the current thread
    ThreadID = mThreadID
End Property

Public Property Get Priority() As Long
    'Returns a long value because the thread might have other priorities
    'than our five in the enum
    
    'Ignore errors to prevent crashing if no thread has been created
    On Error Resume Next
    Priority = GetThreadPriority(mThreadHandle)
End Property

Public Property Let Priority(ByVal tmpValue As Long)
    'Sets the Thread Priority of the actual thread
    mPriority = tmpValue
    Call SetThreadPriority(mThreadHandle, tmpValue)
End Property

Public Property Get Enabled() As Boolean
    'Returns whether the Thread is enabled or not
    Enabled = mEnabled
End Property

Public Property Let Enabled(ByVal tmpValue As Boolean)
    'Enables/Disables the Thread
    
    'Ignore errors to prevent crashing if no thread has been created
    On Error Resume Next
    If tmpValue = True Then
        'Enable the thread
        Call ResumeThread(mThreadHandle)
    ElseIf tmpValue = False Then
        'Disable the thread
        Call SuspendThread(mThreadHandle)
    End If
End Property
Private Sub Class_Terminate()
    Call TerminateCurrentThread
End Sub

Ответить

Номер ответа: 15
Автор ответа:
  j3d1



ICQ: 8370005 

Вопросов: 34
Ответов: 466
  Профиль | | #15 Добавлено: 24.08.04 11:34
Я ещё Формочку для удобства сделал она туда всё выводит

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам