Windows Message für COM/USB aktivität in VB

So weit so gut.

Bisher denke ich über zwei varianten nach:

a) mit einem MAPI Hook die WM_Devicechange abfangen und mit 
DBT_Devicespecific oder DBT_Userdefined ein senden der seriellen 
Schnittstelle feststellen.

b) mit einen eigenen Task dauer abfragen und ... z.B. eine Funktion in 
einem anderen VBA-Task ausführen, Variablen an andere Tasks übergeben 
oder eine eigene WM abschicken.

Bei beiden Varianten stehe ich vor dem Problem dass ich damit nie etwas 
zu tun hatte.

OK, ich habe mich für die multithread variante entschieden.
Ich habe code geschrieben, aber immer noch Probleme damit.

Der testcode ist ohne serielle schnittstelle.
Es geht nur darum mit parallelen Tasks in eine textbox zu schreiben.

1

Option Explicit

2

3

'**********************************************************************************

4

'* Kernel32 Declares                                                              *

5

'**********************************************************************************

6

Public Declare Function CloseHandle Lib "kernel32" _

7

    (ByVal lpHandle As Long) _

8

As Long

9

10

Public Declare Function CreateThread Lib "kernel32" _

11

        (ByVal lpThreadAttributes As Any, _

12

        ByVal dwStackSize As Long, _

13

        ByVal lpStartAddress As Long, _

14

        ByVal lParameter As Long, _

15

        ByVal dwCreationFlags As Long, _

16

        ByVal lpThreadID As Long) _

17

As Long

18

19

'**********************************************************************************

20

'* Functionen and Subs                                                             '*

21

'**********************************************************************************

22

23

Private Sub Doomsdaydevice_Click()

24

    Dim threadhandle As Long

25

    Dim i As Long

26

27

    MultiBox.Text = ""

28

29

    For i = 1 To Round(((Rnd * 10) + 1), 0)

30

        threadhandle = CreateThread(ByVal 0&, 2000, AddressOf thiswillbethepowerthread, ByVal 0&, ByVal 0, ByVal 0&)

31

        CloseHandle (threadhandle)

32

    Next i   

33

End Sub

34

35

Sub thiswillbethepowerthread() 'Der Multithread

36

    Dim i As Integer

37

    For i = 1 To Round(((Rnd * 10) + 1), 0)

38

        Tabelle1.MultiBox.Text = Tabelle1.MultiBox.Text + Str(i)

39

    Next i

40

End Sub

Probleme macht diese Zeile:

1

Tabelle1.MultiBox.Text = Tabelle1.MultiBox.Text + Str(i)

Mit der Zeile erscheint der Error 7 Nicht genug speicher
Löscht man sie, läuft der Programmcode problemlos ab.
Ersetzt man sie mit

1

MsgBox("Tadaa")

so werden alle Threads gestartet, stürzen aber nach ein paar 
weggeklickten MsgBoxen ab, und nehmen das Programm mit sich.

Meine Frage: Was ist los?

Danke, Johannes

Ich hab mich ein bisschen eingelesen und das war meine erste Schätzung.
Leider bin ich an VBA gebunden.

Ich habe etwas von Appartments und Marshalling gelesen, aber noch nicht 
wirklich Ahnung davon.

Kann ich meinen Absturz verhindern wenn ich Events werfe?
Wie funktioniert das mit Events werfen?

Übergaben per Event, wie funktionieren die?

Ich habe jetzt ein Klassenmodul namens multiclass

1

Public Event SendString(ByVal MessageString As String)

2

Public Sub pseudoget()

3

    Dim thisstring As String

4

    thisstring = "Waaaaa"

5

    RaiseEvent SendString(thisstring)

6

End Sub

In einem Modul habe ich dann folgendes formuliert:

1

Public WithEvents EVENTMESSAGE As multiclass

2

3

Private Sub Doomsdaydevice_Click()

4

    Dim mymultiobject As multiclass

5

    Set mymultiobject = New multiclass

6

    mymultiobject.pseudoget

7

End Sub

8

9

10

Sub EVENTMESSAGE_SendString(ByVal MessageString As String)

11

    MsgBox(MessageString)

12

End Sub

Die Zeiele

1

Public WithEvents EVENTMESSAGE As multiclass

führt zu einem Compilerfehler.

Und ich glaube auch die Zeile

1

Sub EVENTMESSAGE_SendString(ByVal MessageString As String)

2

    MsgBox(MessageString)

3

End Sub

macht so noch keinen Sinn.

Insbesondere fehlt auch irgendwo noch ein

1

SET EVENTMESSAGE

Kann jemand meine Verwirrung auflösen?

So, Nachrichten Werfen geht jetzt:
multiclass-Objekt

1

Public Event SendString(ByVal MessageString As String)

2

Public Sub pseudoget()

3

    Dim thisstring As String

4

    thisstring = "Waaaaa"

5

    RaiseEvent SendString(thisstring)

6

End Sub

Hauptteil

1

Dim WithEvents mymultiobject As multiclass

2

Private Sub Doomsdaydevice_Click()

3

    Set mymultiobject = New multiclass

4

    mymultiobject.pseudoget

5

'    Dim i As Long

6

'    For i = 1 To Round(((Rnd * 3) + 1), 0)

7

'        threadhandle = CreateThread(ByVal 0&, 2000, AddressOf mymultiobject, ByVal 0&, ByVal 0, ByVal 0&)

8

'        CloseHandle (threadhandle)

9

'    Next i

10

'    MsgBox ("Ende: " + Str(i) + " threads wurden erstellt")

11

    MsgBox ("waiting")

12

End Sub

13

14

Sub mymultiobject_SendString(ByVal MessageString As String)

15

    MsgBox (MessageString)

16

End Sub

Jetzt habe ich nur noch ein Problem das mymultiobject als eigenen thread 
starten zu lassen. Der Auskommentierte Teil ist mein Gedanke, der 
allerdings nicht zum Ziel führt. Unzulässige verwendung von AdressOf.

Der Grund warum ich das möchte ist folgender: Ich muss eine Art OnCOM 
Event benutzen.

Verwenden darf ich alles was in VBA-ExCel 6.0 zur Verfügung steht.
Meine Überlegung war einen Thread laufen zu lassen, der das Event 
generiert.

VBA threadsicher -> Nein, diese Aussage habe ich nicht gefunden. Aber 
mein Thread soll als einziger auf den InBuffer zugreifen, und verschickt 
gegebenenfalls ein Event. Da sollten keine Konflikte auftreten. Übersehe 
ich da etwas?

ActiveX -> Welche Objekte stehen mir standardmäßig zur Verfügung? Ich 
kenne mich damit nicht so wirklich aus. Wie ich das sehe müsste ich eine 
EXE kompilieren, und diese beifügen. Diese Option steht mir nicht zur 
Verfügung. Anforderung ist: Alles in einer Datei.

Vieles geht mit Timer -> Davon habe ich gelesen, aber mich noch nicht 
beschäftigt. Da der Eingabepuffer ja ein Puffer ist, könnte ich auf 
Echtzeit vermutlich verzichten. Ich habe ca. 8 byte Puffergröße, da 
könnte ich vermutlich auch sequentiell ran.

VB.NET -> Steht mir leider nicht zur Verfügung.

Wenn es absolut nicht geht, kann ich eventuell nochmal verhandeln. Wäre 
aber eher schlecht für mich.

http://www.freevbcode.com/ShowCode.Asp?ID=1287
-> Dies habe ich bereits gelesen, ich lese es jetzt nochmal.
Ich glaube ich bin nicht erfahren genug um das gesamte modell auf einmal 
zu verstehen.
Aus verschiedenen Quellen habe ich bereits herausgefunden, dass:
-Ich ein MTA möchte
-Ich zuerst CoInitialise(Ex) ausführen muss
-(L)RCP wichtig sein könnte
-COINIT der Appartmenttyp its, und ich den Typ Coinit_Multithreaded 
möchte

Ich glaube dass ich das ganze insgesamt allerdings noch nicht verstanden 
habe.

Ich möchte durch dieses neue Post mein vorheriges nicht als unwichtig 
erklären, deshalb seht dieses bitte als Fortsetzung des vorherigen.

Seit dem erstenmal lesen von
http://www.freevbcode.com/ShowCode.Asp?ID=1287
bin ich wohl schon ein bisschen tiefer in der Materie, und habe 
tatsächlich mehr verstanden.

Mir brennen Fragen auf den Lippen, die wichtigste ist:
-wofür brauche ich hier im speziellen die GUID?

Grüße, und Dank im Vorraus

Ja, ich benutze ExCel.
Ja, ich habe 2 Serielle schnittstellen. Eine der beiden ist Virtuell 
(USB)
Randnotiz, die USB-Entscheidung ist erst kürzlich gefallen.

Eine MSCOMM Lizenz liegt nicht vor. MSCOMM muss umgangen werden - 
deshalb der Terz mit den Threads.

So, mittlerweile stürzt mein Mutlithread nicht mehr ab.
Alles was man beachten muss ist dass sich die threads vor dem 
Hauptprogramm beenden.

Wenn ich das ganze jetzt noch auf Messages erweitere, sollte ich 
glücklich sein.
Leider kann ich Messages nur in einem Klassenmodul deklarieren, wodurch 
ich brobleme bekomme, wenn ich "AddressOf Objekt" verwenden will.

Ich möchte ja nicht uneinsichtig wirken, aber ich sehe keine andere 
Möglichkeit für mich.

in einem Modul:

1

Public Sub thiswillbethepowerthread() 'Der Multithread

2

    Call CoInitialize(0)

3

    Dim i As Integer

4

    For i = 1 To Round(((Rnd * 3) + 1), 0)

5

        MsgBox ("tada")

6

    Next i

7

    Call CoUninitialize

8

End Sub

im Hauptteil

1

Public Declare Function CloseHandle Lib "kernel32" _

2

    (ByVal lpHandle As Long) _

3

As Long

4

Public Declare Function CreateThread Lib "kernel32" _

5

        (ByVal lpThreadAttributes As Any, _

6

        ByVal dwStackSize As Long, _

7

        ByVal lpStartAddress As Long, _

8

        ByVal lParameter As Long, _

9

        ByVal dwCreationFlags As Long, _

10

        ByVal lpThreadID As Long) _

11

As Long

12

Declare Function CoInitialize Lib "ole32.dll" _

13

    (ByVal pvReserved As Long) _

14

As Long

15

Declare Sub CoUninitialize Lib "ole32.dll" ()

16

17

Private Sub Doomsdaydevice_Click()

18

    Dim threadhandle As Long

19

    Dim i As Long

20

    MultiBox.Text = ""

21

    For i = 1 To Round(((Rnd * 3) + 1), 0)

22

        threadhandle = CreateThread(ByVal 0&, 2000, AddressOf thiswillbethepowerthread, ByVal 0&, ByVal 0, ByVal 0&)

23

        CloseHandle (threadhandle)

24

    Next i

25

    MsgBox ("Pause here" + vbNewLine + "Counter is: " + Str(i - 1))

26

End Sub

MSCOMM ist frei verfügbar -> hatte ich überlesen.

Also gut, dann seh ichs mir nochmal an :)

OK. die MSCOMM scheint die richtige Wahl für mich zu sein.

Wie kann ich sie einbinden ohne:
-Das Objekt in eine Form zu setzen.
-Eine Lizenz auf jedem Rechner installieren zu müssen.

Am Ende hätte ich gerne alle Dateien in einem Verzeichnid, darum wäre es 
schön wenn ich nicht auf das Windowsverzeichnis zurückgreifen müsste.

Grüße, Johannes

P.S. Ist es angebracht einen neuen thread zu starten?

>>Wie kann ich sie einbinden ohne:
>>-Das Objekt in eine Form zu setzen.
>Das sind VB Grundlagen, lies dir das in einem Buch durch.

Ich mache fast nichts anderes als mich in vb einzuarbeiten.
-Wäre es in einer DLL, dann könnte ich mit DECLARE... arbeiten.
-Wäre es in einer CTL, dann könnte ich evtl mit CreateObject... arbeiten
-Diese Methode: 
http://www.the-starbearer.de/Praxis/ElektronikamPC/RS232/MSCOMM.htm 
möchte ich nicht verwenden. Der benutzer muss dann auf jedem weiteren 
Rechner diverse schritte unternehmen.

>>Eine Lizenz auf jedem Rechner installieren zu müssen.
>Wieso Lizenz, das einzige was du machen mußt ist die dll mitzuliefern
>und auf dem Rechner zu registrieren (mit regsvr32).

MSCOMM braucht eine Lizenz um auf dem jeweiligem Rechner zu laufen. Das 
ist im Grunde nur ein Registry eintrag. Auf VB.NET kann man etwas in 
Richtung:

1

object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"

schreiben um sich den Terz zu sparen.

Probleme in der Anwendung wird alles bereiten was der User tun muss.
Ein Objekt ins ExCel Sheet zu platzieren kommt bei Dieser Anwendung 
leider nicht in Frage.
Die Anforderung an den User soll sein: "Kopiere diesen Ordner auf den 
Computer Deiner Wahl und mache einen Doppelklick auf die ExCel-datei."

Ich glaube nicht, dass das registrieren einer Lizenz und das erstellen 
eines Objekts aus einer OCX wirklich zu den Grundlagen gehrört, gerade 
weil die OnCom Events genutzt werden müssen.
Klar bleib ich dran, ich habe noch bis mitte Juni Zeit :)

Tip: Online-Hilfe nach "Controls dynamisch erstellen" absuchen. Da müßte 
dann beschrieben sein, wie man das macht. Ich bin zu lange raus aus VB, 
ich habs vergessen :(

OT: Kuriboh ist aber ein sehr schwaches Monster... ;-)

>"Controls dynamisch erstellen"
Alles was mit kompilieren zu tun hat darf ich nicht.

>ich vermute hauptsächlich Internet Tutorials
Richtig. Ich habe gehofft meine c++ kenntnisse würden mir über das 
gröbste hinweg helfen.
Ein Buch habe ich dann doch noch: Excel VBA von Monika Weber. Dieses 
Buch ist allerdings für meine Zwecke eher enttäuschend.

>Deshalb der Tip lies ein Buch.
Ich geh zur Bib. Hast Du einen Buchtipp?

>Lizenz sondern von Objekt oder Control
Windows spricht von Lizenz. Wenn man das MSCOMM Objekt einbindet, und 
dann die Module exportiert erhäkt man einen Lizenz Fehler.

>Dein Doppelclickwunsch wird nichts, da in den meisten Fällen die 
Sicherheitseinstellungen von Excel das verhindern werden.
Schwerer schlag für mich, aber auch ein leichter Hoffnungsschimmer - in 
den meisten Fällen.

>OT: Kuriboh ist aber ein sehr schwaches Monster... ;-)
OT: Englisches understatement

Johannes H. wrote:
>>"Controls dynamisch erstellen"
> Alles was mit kompilieren zu tun hat darf ich nicht.
>

Hat es nicht, also darfst du das ;). "Dynamisch erstellen" bedeutet "zur 
Laufzeit erzeugen" - und dementsprechend es auch wieder zur Laufzeit 
zerstören, wenn man es nicht mehr benötigt. Dafür braucht man keinen 
Compiler, das geht auch mit Interpretern wie Excel-VBA.

CreateObject heißt der Befehl übrigens...

>Denke Eventbasiert, entwerfe das ganze als Statusengine und schreibe es
einfach hin.
Ich fürchte hierfür bin ich nicht gut genug

>Das erklärt endlich warum du das so "umständlich" versuchst.
Ich habe schon gemerkt dass VB mir nicht so liegt wie die c Familie.

>Buchtip?:
Ich habe mir jetzt ein VB6 Buch geholt. VB 6 Kompendium von Markt und 
technik. Ein sehr angenehmes Buch. Im wesentlichen werde ich von diesem 
Buch bestätigt.

1.MSCOMM32.ocx nach System32 kopieren
2.mit regsvr32 die Klassen registrieren
3.den Lizenzschlüssel in die Registry eintragen
4.Klasse verwenden

1

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _

2

 "GetSystemDirectoryA" (ByVal lpBuffer As String, _

3

 ByVal nSize As Long) As Long

4

5

Private Sub TheGoButton_Click()

6

    Dim SysDir_API As String * 261

7

    Dim SysDir, OCXPath, Destpath, m As String

8

    Dim switch As Boolean

9

10

    Call GetSystemDirectory(SysDir_API, 260)

11

    Call MsgError("GetSystemDirectory", GetLastError())

12

    OCXPath = DieseArbeitsmappe.Path & "\" & "MSCOMM32.OCX"

13

    SysDir = ""

14

    switch = False

15

16

'*********** String nachbearbeitung **************

17

    Do

18

        m = Left(SysDir_API, 1)

19

        If (m >= Chr(32) And m <= Chr(126) _

20

            And Not (False)) _

21

        Then

22

            SysDir = SysDir + m

23

            SysDir_API = Right(SysDir_API, Len(SysDir_API) - 1)

24

        Else

25

            switch = True

26

        End If

27

    Loop Until (switch)

28

'****************************************************

29

30

    Destpath = SysDir & "\MSCOMM32.OCX"

31

32

    FileCopy OCXPath, Destpath

33

    Call Shell("regsvr32 " & SysDir & "\MSCOMM32.OCX", vbNormalFocus)

34

35

'    Dim MSComm1 As Object

36

'    Set MSComm1 = CreateObject("MSCOMM32.OCX")

37

38

End Sub

Was hier nun noch fehlt:
-TRY-Block um das copy herum
-regsvr32 auf silent umstellen
-Lizenzschlüssel eintragen
-Klasse verwenden

Ich denke mein CreateObjekt Aufruf ist falsch, weil er sich nicht nch 
den Klassen in der registry richtet.
Zunächst arbeite ich aber noch am sauberen registrieren in der Registry.




OT: erhäkt ist erhält, wenn man beim 10-Fingern daneben greift und es 
nicht merkt :)

>3.den Lizenzschlüssel in die Registry eintragen das macht regsvr32
Ach, das geht auch? Ich kann damir nur die Klase eintragen.
HKEY_CLASSES_ROOT\Licenses\ erfolgt kein Eintrag

>>4.Klasse verwenden
>Nein, sauber ist klasse erstellen und kontrollieren ob sie erstellt werden 
konnte, DANN erst verwenden
Ich hatte nur abgekürzt, weil die klasse noch Zukunftsmusik ist.

>Netter Quellcode den du da postest ist der von 1996 oder von >"lernunwilligen" ?
Er ist von mir, die Buchtitel sind mir nicht bekannt.

>Und jetzt mal etwas realer:
>seit winnt (1996?) gibt es Rechte und Beschränkungen aus gutem Grund
>1. regsvr32 kann normalerweise (spätestens ab win2000) nur der
>Administrator zur Registrierung eines Objektes benutzen
>2. Eine normale exceldatei mit Macros (nichts anderes ist dein Code)
>sollte vom Administrator nicht ausgeführt werden, sondern nur von
>Nutzern mit eingeschränkten Rechten.
>3. Ein normaler Nutzer sollte nicht einfach etwas nach System32 kopieren
>Das sind Sicherheitskonzepte die ihre Berechtigung haben und auch nicht
>umgangen werden sollten! Ein Nutzer der diese Konzepte aufhebt wegen
>eines Excelmakros....
Es handelt sich um Laborrechner, die vom Firmennetzwerk geschützt 
werden. Sie laufen im Admin-Mode, soweit ich das beurteilen kann. Ich 
werde das nochmals überprüfen.
Das Konzept ist fehlerhaft wenn es mich im Ausüben meiner tätigkeit 
behindert. Was nutzt mir eine Programmiersprache in der ihc nicht 
programmieren darf? Am liebsten würde ich nicht mit der Registry 
hantieren, oder etwas in System32 kopieren. Aber mir bleibt keine andere 
Wahl - meine Arbeit unterliegt einschränkungen die ich nicht ändern 
kann. Das Threading modell wäre eine Tolle möglichkeit gewesen, aber 
offensichtlich kann man es nciht verwenden. Ich MUSS mit der MSCOMM.OCX 
arbeiten, leider macht diese es erforderlich einträge in der Registry zu 
tätigen. MSCOMM ist nicht überall installiert, und jeder DAU muss mit 
einem Doppelklick das Programm zum laufen bringen. Noch viel schlimmer, 
jeder DAU soll es auf eine Diskette kopieren können und es an einen 
anderen Rechner schleppen, wo er es auch mit einem Doppelklick verwenden 
kann, ohne zusätzlichen Aufwand - zu dem ein IT-Support nötig wäre.

Gerne mache ich es anders. Aber derzeit sehe ich nur 2 Möglichkeiten:
A) Threading zum laufen bringen
B) MSCOMM zur Laufzeit registrieren

Ich möchte wirklich nicht als lernunwillig erscheinen, ohne heute sitze 
ich an dem Problem bereits 127 Stunden. Glaub mir, wenn ich einen 
bequemen Weg sehen würde, ich wäre sofort dabei.

Wenn das so ist...

Wenn das CreateObject fehlschlägt, dann das OCX in das 
Arbeitsmappenverzeichnis kopieren (niemals nach System32) und ein 
ShellExecute auf ne Stapeldatei ausführen. In der Stapeldatei steht drin 
"regsvr32 mscomm.ocx".

Dann blitzt ein einziges mal (wenn OCX unregged) kurz ein DOS-Fenster 
auf und das wars. In die Registry wird zum einen der Pfad des OCX 
vermerkt, zum anderen wird beim Registrieren nicht nur ein Eintrag 
erstellt - es sind derer etliche.

Der CreateObject-Aufruf erwartet eine Zeichenfolge a la 
"BarControl.GDSControl.1".

> Wenn das CreateObject fehlschlägt, dann das OCX in das
> Arbeitsmappenverzeichnis kopieren (niemals nach System32) ...
Warum nicht nach System32?

>Der CreateObject-Aufruf erwartet eine Zeichenfolge a la
>"BarControl.GDSControl.1".
Dachte ich mir, mach ich dann auch so. Thx.

>>Ach, das geht auch? Ich kann damir nur die Klase eintragen.
>>HKEY_CLASSES_ROOT\Licenses\ erfolgt kein Eintrag
>nein höchstwahrscheinlich nicht
Dachte ich mir. Ich mache es jetzt über einen silent call von regedit.

>>Das Konzept ist fehlerhaft wenn es mich im Ausüben meiner tätigkeit
>>behindert. Was nutzt m....
>Ich kenne die Problematik aus dem Support im Uni-Bereich.
>Ich kann dazu nur sagen, ich hoffe ihr habt einen kompetenten Admin und
>der bekommt mit was ihr da treibt. ...
Welche Probleme können in diesem fall auftreten, und mit welchen 
routinen kann ich ihnen ausweichen?

>>Zum Konzept: Zur Registrierung ist ein Installationsprogramm da.(kann
auch eine Batch datei sein)
In eine Batch Datei würde ich schreiben:

1

copy MSCOMM32.OCX c:\windows\system32

2

regsvr32 /s c:\windows\system32\MSCOMM32.OCX

3

regedit.exe /s MSCOMM32.reg

irgendwie entgeht mir warum das anders ist als es in das VBA-Modul 
einzubinden.
Natürlich muss das modul checken ob das schon geschehen ist, um höhere 
Versionen nicht zu überschreiben.

>Was hast du in den 127 Stunden getan?
Zugegeben, ich hab mich ein bisschen verrannt. zunächst wurde 
festgehalten dass ich MSCOMM nicht verwenden darf -> Also wollte ich 
über API gehen. Dann kam heraus dass das RS232 gerät auch den Computer 
anrufen darf - also brauchte ich ein Event, und habe mich in 
Multithreading für Vb eingelesen. Nachdem ich das nicht stabil bekommen 
habe arbeite ich jetzt daran MSCOMM so einzubauen dass man es nciht 
merkt, und es auch keinen stört.

Aktuelle version des "lernunwilligen von 1996"-Codes

1

Option Explicit

2

3

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _

4

 "GetSystemDirectoryA" (ByVal lpBuffer As String, _

5

 ByVal nSize As Long) As Long

6

7

Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" _

8

  (ByVal lpszLongPath As String, ByVal lpszShortPath As String, _

9

  ByVal cchBuffer As Long) As Long

10

11

Private Function shortenAPIstring(API_INPUT As String) As String

12

    Dim m, OUTPUT As String

13

    Dim switch As Boolean

14

    switch = False

15

    OUTPUT = ""

16

    Do

17

        m = Left(API_INPUT, 1)

18

        If (m >= Chr(32) And m <= Chr(126)) Then

19

            OUTPUT = OUTPUT + m

20

            API_INPUT = Right(API_INPUT, Len(API_INPUT) - 1)

21

        Else

22

            switch = True

23

        End If

24

    Loop Until (switch)

25

    shortenAPIstring = OUTPUT

26

End Function

27

28

Private Function PathToShortName(LONGPATH As String) As String

29

    Dim SHORTNAME As String * 1024

30

    Call GetShortPathName(LONGPATH, SHORTNAME, Len(SHORTNAME))

31

    PathToShortName = shortenAPIstring(SHORTNAME)

32

End Function

33

34

Public Sub REGISTER_MSCOMM()

35

    Dim SysDir_API As String * 261

36

    Dim SysDir, OCXPath, LicenseCall, Destpath, m As String

37

38

    Dim COPYOCX, REGOCX, LICENSEOCX As Boolean

39

'TODO ABFRAGEN DURCHFÜHREN

40

    COPYOCX = True

41

    REGOCX = True

42

    LICENSEOCX = True

43

44

'Initialisierung

45

    SysDir = ""

46

    Call GetSystemDirectory(SysDir_API, 260)

47

    SysDir = shortenAPIstring(SysDir_API)

48

' Benötigte Pfade

49

    OCXPath = DieseArbeitsmappe.Path & "\" & "MSCOMM32.OCX"

50

    LicenseCall = "regedit.exe /s " + PathToShortName(DieseArbeitsmappe.Path & "\" & "MSCOMM.reg")

51

    Destpath = SysDir & "\" & "MSCOMM32.OCX"

52

'*********************** Systemaufrufe

53

    If COPYOCX Then _

54

        FileCopy OCXPath, Destpath 'MSCOMM32.OCX nach System32 kopieren

55

    If REGOCX Then _

56

        Call Shell("regsvr32 /s " & SysDir & "\MSCOMM32.OCX", vbHide) 'MSCOMM32.OCX beim system registrieren

57

    If LICENSEOCX Then _

58

        Call Shell(LicenseCall, vbHide) 'MSCOMM Lizenz beim system eintragen

59

End Sub

>Wenn ein Programm installiert wird, sollte der Admin informiert sein.
>Das Programm hat ein Installationsprogramm (in deinem Fall die
>batchdatei) die registriert MSCOMM.OCX und installiert das Programm in einen 
Pfad.
>Dazu werden adminrechte benötigt aber nur bei der Installation.
>Zum ausführen müssen Makros in Office erlaubt sein, sonst fnktioniert es
>nicht. Sowas sollte nur mit Rücksprache geändert werden aufgrund der
>Makrovirenproblematik.
Ich bin auf meinem Rechner Admin, die Laborrechner sind IMO auch 
standardmäßig Admin. Ist aber natürlich ein vernünftiger Einwand.
Ich arbeite gerade an der Überprüfung ob die keys bereits angelegt sind.
Sobald ich damit fertig bin überprüfe ich ob der Rechner bereits als 
admin läuft, tut er das nicht, fordere ich das Passwort und verwende 
RUNAS in der shell.

Dann muss man den admin rufen -> ich bin aus dem Schneider :)

>Das geht ja hier richtig farbig...
OT: Hat mich auch schon begeistert :)

Parallel baue ich noch das gerät, dass dann communiziert.
Ich kann also noch gar keine Details programmieren.
Ich warte noch auf Platinen, dann gehts los :)
Außerdem gibt es eine Vorversion, an der insbesondere dieses problem 
beanstandet wurde.

Die Kommunikation selbst ist dann leicht, das hatte ich wirklich in 
einer Stunde fertig. Ich habe mit einem Kraftmeter herumgespielt - war 
einfach.

>Programmiere es doch auf einem 2. PC, da kannst du schon weitermachen
Gute Idee,... mach ich wahrscheinlich

Der Code um MSCOMM einzubinden ist soweit fertig. Jetzt muss ich nur 
noch klasse erstellen, kontrollieren, verwenden.

Administrator@Domäne müsste man anpassen, ist aber im Firmennetzwerk mit 
übergreifender Domäne unkritisch.

1

Option Explicit

2

3

'Konstanten

4

Const HKEY_CLASSES_ROOT = &H80000000

5

Const HKEY_CURRENT_USER = &H80000001

6

Const HKEY_LOCAL_MACHINE = &H80000002

7

Const HKEY_USERS = &H80000003

8

Const HKEY_PERFORMANCE_DATA = &H80000004

9

Const HKEY_CURRENT_CONFIG = &H80000005

10

Const HKEY_DYN_DATA = &H80000006

11

Const KEY_QUERY_VALUE = &H1

12

Const ERROR_SUCCESS = 0&

13

Const KEY_EXECUTE = &H20019

14

Const USERISADMIN = 1

15

16

'API AUFRUFE

17

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _

18

 "GetSystemDirectoryA" (ByVal lpBuffer As String, _

19

 ByVal nSize As Long) As Long

20

21

Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" _

22

  (ByVal lpszLongPath As String, ByVal lpszShortPath As String, _

23

  ByVal cchBuffer As Long) As Long

24

25

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _

26

        Alias "RegOpenKeyExA" (ByVal HKEY As Long, ByVal _

27

        lpSubKey As String, ByVal ulOptions As Long, _

28

        ByVal samDesired As Long, phkResult As Long) _

29

        As Long

30

31

Private Declare Function RegCloseKey Lib "advapi32.dll" _

32

        (ByVal HKEY As Long) As Long

33

34

Private Declare Function IsNTAdmin Lib "advpack.dll" (ByVal dwReserved As Long, ByRef lpdwReserved As Long) As Long

35

36

37

'INTERFACE FUNKTIONEN

38

Private Function shortenAPIstring(API_INPUT As String) As String

39

    Dim m, OUTPUT As String

40

    Dim switch As Boolean

41

    switch = False

42

    OUTPUT = ""

43

    Do

44

        m = Left(API_INPUT, 1)

45

        If (m >= Chr(32) And m <= Chr(126)) Then

46

            OUTPUT = OUTPUT + m

47

            API_INPUT = Right(API_INPUT, Len(API_INPUT) - 1)

48

        Else

49

            switch = True

50

        End If

51

    Loop Until (switch)

52

    shortenAPIstring = OUTPUT

53

End Function

54

55

Private Function PathToShortName(LONGPATH As String) As String

56

    Dim SHORTNAME As String * 1024

57

    Call GetShortPathName(LONGPATH, SHORTNAME, Len(SHORTNAME))

58

    PathToShortName = shortenAPIstring(SHORTNAME)

59

End Function

60

61

Private Function KEYEXISTS(HKEY As Long, SubKey As String) As Boolean

62

    Dim KnowerOfKeyStatus As Boolean

63

    Dim Result, handle As Long

64

    Result = RegOpenKeyEx(HKEY, SubKey, 0, KEY_EXECUTE, handle)

65

    If Result = ERROR_SUCCESS Then

66

        KnowerOfKeyStatus = True

67

    Else

68

        KnowerOfKeyStatus = False

69

    End If

70

    RegCloseKey (handle)

71

    KEYEXISTS = KnowerOfKeyStatus

72

End Function

73

74

75

'KERNFUNKTION

76

Public Sub REGISTER_MSCOMM()

77

    Dim SysDir_API As String * 261

78

    Dim SysDir, OCXPath, LicenseCall, Destpath, m As String

79

    Dim COPYOCX, REGOCX, LICENSEOCX As Boolean

80

    Dim USER_STATUS

81

'Initialisierung

82

    USER_STATUS = IsNTAdmin(ByVal 0&, ByVal 0&)

83

    SysDir = ""

84

    Call GetSystemDirectory(SysDir_API, 260)

85

    SysDir = shortenAPIstring(SysDir_API)

86

' Benötigte Pfade

87

    OCXPath = DieseArbeitsmappe.PATH & "\" & "MSCOMM32.OCX"

88

    LicenseCall = "regedit.exe /s " + PathToShortName(DieseArbeitsmappe.PATH & "\" & "MSCOMM.reg")

89

    Destpath = SysDir & "\" & "MSCOMM32.OCX"

90

'ABFRAGEN DURCHFÜHREN

91

    If Dir(Destpath) = "" Then

92

        COPYOCX = True

93

    Else

94

        COPYOCX = False

95

    End If

96

    REGOCX = Not KEYEXISTS(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\MSCOMMLib.MSComm")

97

    LICENSEOCX = Not KEYEXISTS(HKEY_CLASSES_ROOT, "Licenses\4250E830-6AC2-11cf-8ADB-00AA00C00905")

98

'*********************** Systemaufrufe

99

    If Not USER_STATUS = USERISADMIN And ((COPYOCX) Or (REGOCX) Or (LICENSEOCX)) Then

100

        MsgBox ("Ein Problem ist aufgetreten" & vbLf & "Der Benutzer hat keine ADMIN rechte, und es ist eine Teilinstallation erforderlich" & vbLf & "Sie werden nun ein bis drei mal aufgefordert das Passwort für den Account 'Administrator' einzugeben." + vbLf + "Sollten die Probleme weiter auftreten loggen sie sich einmalig als administrator ein, und starten sie das Programm erneut.")

101

        If COPYOCX Then _

102

            FileCopy OCXPath, Destpath 'MSCOMM32.OCX nach System32 kopieren

103

        If REGOCX Then _

104

            Call Shell("runas /user:Administrator@Domäne " + "regsvr32 /s " & SysDir & "\MSCOMM32.OCX", vbHide) 'MSCOMM32.OCX beim system registrieren

105

        If LICENSEOCX Then _

106

            Call Shell("runas /user:Administrator@Domäne " + LicenseCall, vbHide) 'MSCOMM Lizenz beim system eintragen

107

    Else

108

        If COPYOCX Then _

109

            FileCopy OCXPath, Destpath 'MSCOMM32.OCX nach System32 kopieren

110

        If REGOCX Then _

111

            Call Shell("regsvr32 /s " & SysDir & "\MSCOMM32.OCX", vbHide) 'MSCOMM32.OCX beim system registrieren

112

        If LICENSEOCX Then _

113

            Call Shell(LicenseCall, vbHide) 'MSCOMM Lizenz beim system eintragen

114

    End If

115

End Sub

Ich hoff, ich darf mal ne kurze Frage zwischendurch stellen.

Ich arbeite mit VB.Net und will auf eine Chipkarte zugreifen... diese 
steckt in einem Kartenleser der an einem USB-Port steckt... aber ich 
weiß nicht mal wie ich mittels VB.net auf diesen Kartenleser zugreifen 
kann...

Könnt ihr mir helfen und sagen, wie ich den USB-Port am besten 
anspreche?

Mittlerweile funktioniert das mit MSCOM wirklich gut.

>Wenn sich WAS tut, musst Du WAS machen?
>Wenn Daten einfliegen, diese speichern (im ExcelBlatt oder in einer
Datei)?
>Oder was ganz anderes?

Wenn sich egal was tut, muss ich egal was machen :)
Was ich wann tue ist imo recht schnuppe.
Im Detail sendet das Gerät einen String, der dann aufgeschlüsselt werden 
muss, und je nach string muss anders reagiert werden.

>Denn Funktionen in VBA, welche auf die serielle Schnittstelle zugreifen
können, kann man sehr gut auch ohne MSCOMM uswusf. realisieren.

Ja, kann man. Ich wollte um MSCOM herum, weil es A) eine registrierung 
im System benötigt und B) zusätzliche Dateien braucht.
Es gibt in VB6.0 aber IMO keinen Weg um MSCOMM herum, da Multithreading 
nicht stabil zum Laufen gebracht werden kann.

>Ob das jetzt was nützt, weiss ich nicht, Du kannst Dir den Link ja mal
ansehen Beitrag "Re: benötige Hilfe zu Excel Makro"

Cool, danke. Das werde ich mir definitiv durchlesen.

>Ich hoff, ich darf mal ne kurze Frage zwischendurch stellen.
Mach besser deinen eigenen Thread auf, dieser neigt sich zum Ende.

>Ich arbeite mit VB.Net und will auf eine Chipkarte zugreifen... diese
steckt in einem Kartenleser der an einem USB-Port steckt... aber ich
weiß nicht mal wie ich mittels VB.net auf diesen Kartenleser zugreifen
kann...

>Könnt ihr mir helfen und sagen, wie ich den USB-Port am besten
anspreche?

Mit USB habe ich keine große erfahrung, und bin davon derzeit wieder 
abgekommen.

Generell scheint man aber eine GUID zu brauchen, die man über das 
system, oder mitgelieferte Treiber erhalten kann. Die GUID ist eine Art 
Zeiger auf eine Liste von Geräten, die man auf das Richtige Gerät hin 
durchsucht (handle aufmachen, schauen, ggf handle zumachen) Hast Du 
einmal den richtigen Handle, musst Du mit den funktionen im 
mitgelieferten Treiber das Gerät benutzen.

Das ist nur ein kleiner Richtungshinweis. Mit etwas glück korrigiert 
mich gleich ein vollprofi :)

Grüße, und Dank allen für ihre Hilfe.
Insbesondere Wolfram.

Danke für deine Antwort... leider kenn ich mich immer noch kein bisschen 
aus...

Also was ich genau machen will:
In einem Kartenleser, der am USB-Port hängt, ist eine Chip-Karte. Auf 
dem Chip dieser Karte befindet sich ein Zertifikat... dieses soll 
gelesen werden und als Enum abgespeichert werden. Und ich habe noch 
nicht mal einen kleinen Ansatz dies zu lösen :(

Da ich neu bin bei VB.Net - dies aber nur mit VB.Net lösen will (um dies 
besser kennen zu lernen) - brauche ich jeden kleinsten Hinweis, den ich 
bekommen kann...

PS: Ich habe keine Software zum Kartenleser

Danke im schon im Voraus

PS: wie kann ich eventuell eine GUID in mein Programm einbauen?

Du solltest wirklich einen eigenen Thread starten :)

Also ich habe auch keine Ahnung, aber:

http://www.microsoft.com/germany/msdn/library/office/OfficeVBAUndDieWindowsAPI.mspx?mfr=true
http://www.chf-online.de/api/apilandsprache.htm
http://www2.hawaii.edu/~hermany/api.htm
http://proyectosfie.com/html/usb/libro/capitulo13.pdf
http://msdn2.microsoft.com/en-us/office/aa905357.aspx
http://msdn2.microsoft.com/en-us/library/ms789918.aspx
http://msdn2.microsoft.com/en-us/library/aa476228.aspx
http://msdn2.microsoft.com/en-us/library/aa476213.aspx
http://forum.microchip.com/tm.aspx?m=81752&mpage=1&key=&#121122
http://www.microchip.com/stellent/idcplg?IdcService=SS_GET_PAGE&nodeId=1406&dDocName=en023805
http://www.comvcon.com/VB6MCHPUSB.html

Das meiste wird Dir nicht helfen, ich habe einfach blind meinen usb-link 
ordner kopiert

Johannes H. wrote:
> Du solltest wirklich einen eigenen Thread starten :)

hab i bereits :)



trotzdem würd ich noch gerne wissen, wie ich den GUID verwenden kann 
bzw. welche? Geräteklasse-GUID oder Bustyp-GUID? Oder ginge das nicht 
mit der Geräte-ID?