Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0101: Multimedia-Timer sicher nutzen

 von 

Beschreibung 

Der Code zeigt die Verwendung des Multimedia-Timers in einer sicheren Implementation.

Multimedia-Timer laufen in ihrem eigenen Thread, worauf die VB-Runtime empfindlich in Form von Abstürzen reagiert. Um dies zu vermeiden leitet der Code die Events in den VB-eigenen Thread um. Dies kann zwar prinzipiell auch mit purem VB-Code geschehen, allerdings kann man damit nicht mit absoluter Sicherheit ausschliessen, dass unter bestimmten Umständen doch Abstürze entstehen. Aus diesem Grund verwendet dieser Tipp eine kurze ASM-Prozedur, die seitens des Timers angesprungen wird. Innerhalb der Prozedur wird lediglich ein SendMessage mit entsprechenden Parametern aufgerufen, wodurch das System zum VB-eigenen Thread wechselt und in dessen Kontext die Message an ein Usercontrol leitet. Um für das Abfangen der Message ein Subclassing zu vermeiden, wurde hier die WM_CHAR-Message gewählt, wodurch sich bequem das KeyPress-Event ausnutzen lässt.

Update am 29.12.2008: Dieser Tipp wurde von idiv mithilfe des Tippuploads komplett überarbeitet und ersetzt. Dabei wurde der Code in ein wiederverwendbares Objekt gekapselt.

Dieser Tipp funktioniert entweder nur in kompilierter Form oder benötigt eine DLL/OCX-Datei. Diese Binärdateien sind dem Tipp hinzugefügt worden, um seinen Funktionsumfang darstellen zu können. Vor dem Upload wurden sie auf Viren geprüft.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

RtlMoveMemory (CopyMemory), GetModuleHandleA (GetModuleHandle), GetProcAddress, VirtualAlloc, VirtualFree, VirtualLock, timeKillEvent, timeSetEvent

Download:

Download des Beispielprojektes [3,28 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: MMTimer "MMTimer1"
Option Explicit

Private WithEvents Timer As MMTimer

Private Sub Command1_Click()
    MMTimer1.StartTimer 1, 1, False
End Sub

Private Sub Command2_Click()
    MMTimer1.StopTimer
End Sub

Private Sub Form_Load()
    Set Timer = MMTimer1
End Sub

Private Sub MMTimer1_Timer()
    Static counter As Long
    
    counter = counter + 1
    Me.Caption = CStr(counter)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--- Anfang benutzerdefiniertes Steuerelement "MMTimer" alias MMTimer.ctl ---
Option Explicit

Private Declare Function VirtualAlloc Lib "kernel32.dll" ( _
                         ByRef lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
                         
Private Declare Function VirtualFree Lib "kernel32.dll" ( _
                         ByRef lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
                         
Private Declare Function VirtualLock Lib "kernel32.dll" ( _
                         ByRef lpAddress As Any, _
                         ByVal dwSize As Long) As Long
                         
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const MEM_RELEASE As Long = &H8000&
Private Const WM_CHAR As Long = &H102

Private Declare Sub CopyMemory Lib "kernel32.dll" _
                    Alias "RtlMoveMemory" ( _
                    ByRef Destination As Any, _
                    ByRef Source As Any, _
                    ByVal Length As Long)
                    
Private Declare Function GetProcAddress Lib "kernel32.dll" ( _
                         ByVal hModule As Long, _
                         ByVal lpProcName As String) As Long
                         
Private Declare Function GetModuleHandle Lib "kernel32.dll" _
                         Alias "GetModuleHandleA" ( _
                         ByVal lpModuleName As String) As Long
                         
Private Declare Function timeKillEvent Lib "winmm.dll" ( _
                         ByVal uID As Long) As Long
                         
Private Declare Function timeSetEvent Lib "winmm.dll" ( _
                         ByVal uDelay As Long, _
                         ByVal uResolution As Long, _
                         ByVal lpFunction As Long, _
                         ByVal dwUser As Long, _
                         ByVal uFlags As Long) As Long
                         
Private Const TIME_ONESHOT As Long = 0&
Private Const TIME_PERIODIC As Long = 1&
Private Asm As Long
Private TimerId As Long

Public Event Timer()

Public Sub StartTimer(ByVal Interval As Long, ByVal Resolution As Long, _
    ByVal OneShot As Boolean)
    
    ' sicherstellen, dass inerhalb dieser Instanz der Timer beendet ist
    StopTimer
    
    If OneShot = True Then
        TimerId = timeSetEvent(Interval, Resolution, Asm, 0, TIME_ONESHOT)
    Else
        TimerId = timeSetEvent(Interval, Resolution, Asm, 0, TIME_PERIODIC)
    End If
End Sub

Public Sub StopTimer()
    If TimerId <> 0 Then
        timeKillEvent TimerId
        TimerId = 0
    End If
End Sub

Private Sub UserControl_Initialize()
    Dim Arr(0 To 7) As Long
    Dim Tmp As Long
    
    ' push lParam
    ' push wParam
    ' push Msg
    ' push hWnd
    ' mov eax, SendMessage
    ' call eax
    ' ret 20
    Arr(0) = &H33221168
    Arr(1) = &H22116844
    Arr(2) = &H11684433
    Arr(3) = &H68443322
    Arr(4) = &H44332211
    Arr(5) = &H332211B8
    Arr(6) = &HC2D0FF44
    Arr(7) = &H14
    Tmp = 0 ' lParam setzen
    CopyMemory ByVal CLng(VarPtr(Arr(0)) + 1), Tmp, Len(Tmp)
    Tmp = 18 ' wParam setzen; 18 ist Charcode für ein nicht darstellbares
             ' Zeichen, das nun als ID für den Timer zweckentfremdet wird
    CopyMemory ByVal CLng(VarPtr(Arr(1)) + 2), Tmp, Len(Tmp)
    Tmp = WM_CHAR ' Message; damit wird das KeyPress-Event des angegebenen
                  ' Fensters angesprungen
    CopyMemory ByVal CLng(VarPtr(Arr(2)) + 3), Tmp, Len(Tmp)
    Tmp = UserControl.hWnd ' Fenster, an den die Timermessage geleitet wird
    CopyMemory ByVal CLng(VarPtr(Arr(4)) + 0), Tmp, Len(Tmp)
    
    ' Nachrichtenfunktion festlegen
    Tmp = GetProcAddress(GetModuleHandle("user32.dll"), "SendMessageA")
    CopyMemory ByVal CLng(VarPtr(Arr(5)) + 1), Tmp, Len(Tmp)
    
    ' verschieben in NX-kompatiblen Speicher
    Asm = VirtualAlloc(ByVal 0, 32, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    VirtualLock ByVal Asm, 32
    CopyMemory ByVal Asm, Arr(0), 32
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    If KeyAscii = 18 Then
        ' event vom timer
        RaiseEvent Timer
    End If
End Sub

Private Sub UserControl_Terminate()
    ' sicherstellen, dass Timer beendet ist und virtuellen Speicher aufräumen
    StopTimer
    VirtualFree ByVal Asm, 0, MEM_RELEASE
End Sub
'--- Ende benutzerdefiniertes Steuerelement "MMTimer" alias MMTimer.ctl ---
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

WriteTo - Dwargh 16.07.12 13:47 5 Antworten

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 15 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von CH.W am 19.02.2005 um 16:34

Hallo !
Ich habe das Problem so gelöst, dass ich den Callback immer
nur einmal aufrufen lasse (hinterstes Argument von SetEvent auf 0) und dann, sobald die Callback aufgerufen wird, startet diese dann einen neuen 1-Mal-Ereignis-Timer. Dadurch verliert man zwar minimal an genauigkeit ( nämlich genau soviel, wie das, was in der Callback-funktion passiert, dauert), aber dafür passiert garantiert kein Überlappendes aufrufen der Funktion, während der alte AUfruf noch garnicht bei EndSub angekommen ist.

PS: Auf das timeKillEvent kann man auf verzichten

(Läuft in IDE als auch in .EXE unter VB5/wXP)

'Aus der Callback-Funktion heraus aufrufen

Sub Hi_Res()

'Timer abschalten
timeKillEvent idHiResTimer

[....]

'Timer neu setzen
idHiResTimer = timeSetEvent(500, 0, AddressOf clbHiResTimer, 0, 0)

End Sub

Kommentar von Timon am 19.01.2005 um 13:06

[Windows 98 / VB6]


>>Zum Tipp: Das enthaltene exe funktioniert. Wenn ich das Projekt selber kompiliere (P-Code und Native-Code) funktioniert es nicht.


>>Ich habe selber ein bischen herumexperimentiert und folgendes herausgefunden:

-Diese API eignet sich hervoragend für z.B einen Counter, doch sobald ein grösserer Callbackprozedur (vor allem mit Schleifen und Sub aufrufen) geschrieben wird kann es Fehler geben.

-Es kann (wie von Ewms am 20.07.2002 geschreiben) keine API aufruf in der Prozedur erfolgen, wenn das exe mit Nativ-Code erstellt wurde.

-Es dar kein MsgBox Aufruf (auch nicht eine Sub mit MsgBox Aufruf) erfolgen (P- und Nativ-Code).

-Bei For-Schleifen verhaltet sich das exe anders, ja nach dem ob es mit P- oder Nativ-Code erstellt wurde. (Selber ausprobieren...)

-Allgemein ist zu beachten das die Callbackprozedur aufgerufen wird, auch wenn sie noch nicht abeschlossen ist. Daher kann es zu Problemen führen wenn die Prozedur länger dauert als die Triggerzeit.


...Bei dieser API heist es selber ausprobieren ob sie für eim Programm geeignet ist. Wichtig zu beachten ist, das manchmal nach einem Fehler, eine funktionierende exe zuerst nicht geht!


Wenn man ein Timer änlich dem vom vB haben will, sollte man es mit den API's SetTimer und KillTimer (wie z.B. von Michael Drobilitsch am 22.03.2003 gepostet) machen. Dieser ist zwar etwa gleich ungenau wie der von vB, hat aber trotzdem Vorteile (z.B keine Unterbrechung bei einer MsgBox)


Ich hoffe ich könnte damit vielen Helfen
Gruss Timon


P.S Ich kenn den Unterschied zwischen P- und Nativ-Code nicht, wenn ihn jemand weis, soll er ihn doch hier kurz erklären.

Kommentar von Philipp Stephani am 17.10.2004 um 23:31

So wie es scheint, feuert der Timer zu schnell und die Callbackprozedur kann nicht abgeschlossen werden, bevor das nächste Event kommt. Es ist ohnehin problematisch, Callbackfunktionen außerhalb der verwalteten Nachrichtenschlange zu verwenden. So wie es aussieht, kann ich nur zwei Sachen empfehlen: Entweder den VB-Timer oder eine andere Programmiersprache.

Kommentar von Oliver am 10.04.2003 um 13:09

http://www.mvps.org/ccrp/controls/ccrptimer6.htm

Kommentar von Michael Drobilitsch am 22.03.2003 um 16:04

ups, die Zeile mit KillTimer sollte natürlich heissen:

m_lTimer = KillTimer(0, m_lTimer )

sorry, blöde schlamperei bei mir

Kommentar von Michael Drobilitsch am 22.03.2003 um 16:00

Vielleicht hilfts ja:

Option Explicit

Declare Function SetTimer Lib "user32" (ByVal hWND As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWND As Long, ByVal nIDEvent As Long) As Long

Private m_lTimer As Long '// Timer-ID for the Server Service Procedures

Public Function InitServerService()
m_lTimer = SetTimer(0, 1, 500, AddressOf ServerService)
Debug.Print m_lTimer '// must be <>0
End Function

Public Function DestroyServerService()
m_lTimer = KillTimer(0, m_lServerService)
Debug.Print m_lTimer '// must be <>0
End Function

'//============================================================================================
'// Server-Service-Procedure
'// Cleanup hanging sockets, send stats to log- and console-clients, and much more
Private Sub ServerService(ByVal hWND As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Debug.Print "timer"
End Sub
Option Explicit

Declare Function SetTimer Lib "user32" (ByVal hWND As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWND As Long, ByVal nIDEvent As Long) As Long

Private m_lTimer As Long '// Timer-ID for the Server Service Procedures

Public Function InitServerService()
m_lTimer = SetTimer(0, 1, 500, AddressOf ServerService)
Debug.Print m_lTimer '// must be <>0
End Function

Public Function DestroyServerService()
m_lTimer = KillTimer(0, m_lServerService)
Debug.Print m_lTimer '// must be <>0
End Function

'//============================================================================================
'// Server-Service-Procedure
'// Cleanup hanging sockets, send stats to log- and console-clients, and much more
Private Sub ServerService(ByVal hWND As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Debug.Print "timer"
End Sub

Kommentar von Dirk am 10.11.2002 um 01:39

Hallo.
Ich verwende VB4.
Zum aktivieren des Timers wird ja im Prinzip folgende Zeile verwendet:
Timer2 = timeSetEvent(Freq2, Res2, AddressOf Timer2Clb, 0, Mode)
Mein Problem ist, dass VB4 anscheinend des Befehl "AddressOf" nicht kennt, denn es will danach die Zeile beendet sehen und ich kann das Prog. also nicht ausfuehren.
Die von ActiveVB gestellte, kompilierte .exe lief allerdings einwandfrei.
Hat jemand eine Idee, was ich da jetzt machen sollte?

Danke im Vorraus.
Dirk

Kommentar von Oliver am 29.10.2002 um 08:36

Hallo Leute,

ich habe auch eine Weile vergeblich versucht, das Ding unter VB6/NT zum Laufen zu bekommen. Immer wieder kam als .exe der Absturtz. Dann bin ich auf die Homepage von Sebastian Thomschke (http://www.sebthom.de ) gestoßen und dort fand ich den entscheidenden Tip! In seinem dort als VB-Freeware verfügbaren HiResTimer macht er folgendes:

In der Callback-Funktion des Timers wird nur via PostMessageA ein Tastaturereignis ausgelöst. Alles weitere findet dann (entkoppelt von der Callback-Funktion, die ja SEHR kurz sein muß um keinen Absturtz zu bekommen) in der _Keypressed-Sub des addressierten Forms statt. Seltsamerweise darf man sich dazu nicht einfach mittels "declare" die PostMessageA-Funktion aus der API holen - das führt weiterhin zum Absturtz.

Es klappt aber, wenn man sich eine TLB bastelt (siehe http://support.microsoft.com/default.aspx?scid=KB%3BEN-US%3BQ143258& ). Das entsprechende ODL-File sieht dann folgendermaßen aus:

[
uuid(b0ee95ca-64ac-41ea-9b14-03b6a0e3107f),
helpstring("PostMessageA TypeLibary"),
lcid(0x9),
version(1.0)
]
library PostMessage
{
[dllname("user32.dll")]
module APIDeclare
{
[entry("PostMessageA")] long PostMessageA([in] long hWnd, [in] long Msg, [in] long wParam, [in] long lParam);
};
}

Wenn man das dann mittels "mktyplib /nocpp PostMessageA.odl" in eine TLD umwandelt und diese dann als Verweis in sein VB-Projekt aufnimmt, kann man in die Callback-Funktion des Timers einfach schreiben:

Call PostMessageA(frmMain.hWnd, &H102, AsciiCode, 0)

AsciiCode muß man natürlich noch durch einen eigenen Code ersetzen, den man denn in frmMain_Keypressed abfragt.

Nachteil an der Sache ist natürlich, daß der Timer dann nicht mehr ganz so genau ist, da der auszuführende Code erst durch eine Message aktiviert wird und das kann eine kurze Zeit dauern. Aber da Windows ja sowieso kein echtes RealtTime-Betriebssystem ist, geht das noch ...

Gruß,
Oliver

Kommentar von Oliver am 30.09.2002 um 20:15

Ich habe auf NT und Win95 mit der winmm.dll einen Timer realisiert. Dieser funktioniert auch in der IDE (VB6), als exe wird ein Fehler in der dem Modul MSVBVM60.DLL gemeldet. Kann ich diesen Timer überhabt auf NT oder 95 laufen lassen?

Kommentar von Steffen Braun am 25.08.2002 um 13:52

VB6/Win98
Mit P-Code Compilen FUNKTIONIERT!!! (erstmal)

Kommentar von Ewms am 20.07.2002 um 11:27

Yoho,
ich weis jetzt sogar warm, bzw. wann es nicht funktioniert. Und zwar gibt bei Microsoft eine neue Info zu holen:
**********************
Remarks
Applications should not call any system-defined functions from inside a callback function, except for PostMessage, timeGetSystemTime, timeGetTime, timeSetEvent, timeKillEvent, midiOutShortMsg, midiOutLongMsg, and OutputDebugString.
***************************
Und dem ist auch so. Wenn in der CallbackMethode des Timers nichts kritisches gemacht wird geht auch die kompillierte Exe (gestested VB6 Win98). Sind aber kritische Aufrufe drin. Wie z.B. das Anstossen eines OneShot Timers kachelt der ganze thread ab.
Lösung: Keine.
*Seufz*
Asmodi

Kommentar von Florian R. am 12.07.2002 um 17:09

Ich glaub ich hab die Lösung.
Man muss einfach drauf achten, das die EXE mit Native-Code und nicht mit P-Code-EXE erzeugt wird.

Kommentar von Michael Eger am 28.11.2001 um 10:58

Bei mir läuft beides, das Projekt in der Entwicklungsumgebung und die EXE Datei. Ich verwende VB6 und Win 2000 Prof.
mfg
Michael

Kommentar von Stefan am 07.08.2001 um 15:55

Bei mir (Win98/VB 6.0) läuft der Tip sowohl in der IDE als auch als EXE. Ich kann mir auch nicht denken, warum er unter VB 6 nicht laufen sollte
MfG Stefan

Kommentar von Dr. Pablo Wessig am 05.05.2001 um 15:13

Hallo,
ich habe eine Frage bezgl. des Tips 101 (Praezisionstimer). Ich benoetige für eine 3D-Anwendung zur Ansteuerung einer 3D-Brille einen extrem schnellen Timer um zwischen den beiden Teilbildern (links und rechts) unter Direct3D zu wechseln. Die 50 ms des VB-Timers sind dafür zu lang. Nun habe ich es mit der Timerfunktion aus der winmm.dll versucht, aber die Callback-Funktion wird einmal aufgerufen, rendert die Szene und dann ist das ganze VB abgestuerzt. Compiliere ich die Anwendung, dann stuerzt die exe mit einer Schutzverletzung ab. Einen Zusammenhang mit der Timerfrequenz habe ich nicht feststellen koennen. Spricht etwas dagegen, diesen Timer zum Rendern von D3D-Szenen zu benutzen?
Danke im Voraus fuer jede Hilfe.
Gruss Pablo