| |
Fortgeschrittene ProgrammierungStart einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Woellmi | Datum: 26.05.16 09:20 |
| Hallo zusammen,
das Ziel ist es neben einigen anderen Aufgaben (u.a. INI lesen, Dateien kopieren)
im Ergebnis eine als Aufrufparameter übergebene externe VB6 Anwendung
mit einem VB6 Programm zu starten.
Hierzu gehe ich wie folgt vor:
VB6 Projekt: besteht nur aus einer Sub Main() (also keine Forms)
- Ich werte die Aufrufparameter aus (vollständiger Pfad incl. Name der zu startenden Datei)
- Ich analysiere die Umgebung (Infos aus INI's usw.)
- Ich prüfe, ob die externe Anwendung schon gestartet ist
(Wenn ja, Fehlermeldung und Abbruch, sonst weiter)
- Sollte alles OK sein werden ein paar Dateien kopiert und dann wird über eine
Funktion, die aus der "Main" aufgerufen wird die externe Anwendung gestartet.
- Hierzu verwendete ich abwechselnd (natürlich immer nur eine Variante) folgenden Code in der aufrufenden Funktion:
Kern der Funktion "EXEStartOK"
nResult = Shell(sFile, vbNormalFocus) nResult = ShellExecute(hWnd, "", sFile, "", sWorkDir, SW_SHOWNORMAL) - Resultiert ein Fehler, wird eine Meldung angezeigt.
- Resultiert kein Fehler, wird die "Aufrufende VB6 Anwendung" ohne weitere
Meldung beendet. Man merkt ja, dass die aufgerufene Anwendung gestartet wurde.
Und nun mein Problem:
Alles funktioniert reibungslos, die Aufgaben werden erledigt und die externe Anwendung
startet. Und trotzdem resultiert bei meinem aufrufenden Programm eine Fehlermeldung.
Und zur Krönung, dieser Effekt tritt nur beim Start der EXE und nicht in der IDE auf.
Anwendungsgerüst
Sub Main()
Dim bExtAppIsRunning as Boolean
Dim bStartOK as Boolean
bStartOK = False
bExtAppIsRunning =IsEXERunning(sFile)
If Not bExtAppIsRunning Then
bStartOK = EXEStartOK(sFile)
End If
If Not bStartOK Then
If bExtAppIsRunning Then
MsgBox "Externe Anwendung ist bereits gestartet!"
Else
MsgBox "Beim Aufruf der externen Anwendung trat ein Fehler auf!"
End If
End If
End
End Sub Obwohl die externe Anwendung vorher nicht gestartet war und
im Ergebnis des Aufrufes erfolgreich gestartet wurde, resultiert
beim Ausführen der "EXE" (nicht in der IDE) die Fehlermeldung
==> "Externe Anwendung ist bereits gestartet!"
Wo ist mein Fehler?
Woran habe ich nicht gedacht?
Als evtl. wichtige Hintergrundinfo:
Das aufgerufene Programm führt natürlich einige Operationen aus und
meldet dann ein Ergebnis in Form einer MsgBox. Dies kann dann kurz
bestätigt werden und anschließend erscheint ein Login Dialog.
Es ist übrigens egal, ob ich den Code unter Win10 x64 oder unter WinXP
ausführe.
Hmm, trotzdem sieht es jedoch so aus, als ob "warum auch immer"
meine Abfrage auf "IsEXEXRunning" aus der "Main" doppelt ausgeführt wird.
Jeder Hinweis ist willkommmen
Danke schon jetzt
Tschaui
Woellmi | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Blackbox | Datum: 26.05.16 11:35 |
| Hallo Woellmi,
verwende die PrevInstance-Eigenschaft des App-Objekts. Damit bist Du immer auf
der sicheren Seite. Sie ist FALSE, wenn die Anwendung noch nicht gestartet wurde
und TRUE, wenn eine Instanz davon läuft. | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Woellmi | Datum: 26.05.16 23:33 |
| Hi Blackbox,
erstmal vielen Dank für den Hinweis.
Leider hatte ich diese Idee auch schon und
habe dies nur vergessen mit anzugeben.
Dies sieht dann so aus.
Sub Main()
Dim bExtAppIsRunning as Boolean
Dim bStartOK as Boolean
If Not App.PrevInstance Then
bStartOK = False
bExtAppIsRunning =IsEXERunning(sFile)
If Not bExtAppIsRunning Then
bStartOK = EXEStartOK(sFile)
End If
If Not bStartOK Then
If bExtAppIsRunning Then
MsgBox "Externe Anwendung ist bereits gestartet!"
Else
MsgBox "Beim Aufruf der externen Anwendung trat ein Fehler auf!"
End If
End If
End If
End
End Sub Hat leider auch nicht geholfen!
Dies war dann auch der Anlass mich an Euch zu wenden.
Ich muss wohl noch etwas testen, irgendwo muss doch der "Haken" liegen.
Wie im ersten Posting beschrieben wird eine exteren VB6 Anwendung gestartet,
die dann die kopierten Dateien zur Freischaltung verwendet.
Wurde der Freischaltprozess (extern gestartete Anwendung) erfolgreich
durchgeführt, wird der Erfolg in der externen Anwendung mittels "MsgBox" gemeldet.
Diese MsgBox muss dann mit "OK" bestätigt werden.
In der IDE stelle ich fest, dass mein Aufrufprogramm solange stehen bleibt,
bis die MsgBox der aufgerufenen Anwendung bestätigt wurde. Dann wird die Abarbeitung
normal fortgesetzt und die aufrufende Anwendung normal beendet.
Aber wie gesagt nur in der IDE.
Nun hatte ich früher mal eine EXE mit PowerBasic geschrieben, mit der eine externe
Anwendung verzögert gestartet wird. Die funktioniert auch prima, nur eben mit meiner
aufgrufenen Datei ebenfalls nicht. D.h. der Aufruf alles OK, dochauch hier wird dann eine
Fehlermeldung (also definierte MsgBox aus dem Programm)
generiert. Ich prüfe die Aufrufparameter und wenn hier etwas nicht stimmt, wird dies gemeldet.
Und, obwohl alles super OK ist wird nach erfolgreicher Ausführung ein Fehler des Aufrufes gemeldet.
Also genau wie mit dem hier erörterten Aufruf Prog.
Ich vermute nun, dass die MsgBox der aufgerufenen Datei das Problem ist und im "Aufruf PRG"
diese Reaktion hervorruft.
Ich werde nun mal eine API MsgBox ausprobieren (also in der aufgerufenen Datei) ggf. sieht es ja
andres aus.
Wenn das auch alles nicht hilft, werde ich mal versuchen eine kleine Demo beider Programme
zu posten.
Also danke für die Antwort und sorry für meinen langen Text.
Tschaui
Woellmi | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: effeff | Datum: 27.05.16 11:52 |
| Nun... startest Du die EXE, welche von Deinem Programm aufgerufen wird, tatsächlich zweimal?
Dein Code:
Kern der Funktion "EXEStartOK"
nResult = Shell(sFile, vbNormalFocus)
nResult = ShellExecute(hWnd, "", sFile, "", sWorkDir, SW_SHOWNORMAL) Warum startest Du denn das einmal in einer Shell und dann gleich nochmals per API?
EALA FREYA FRESENA | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Blackbox | Datum: 27.05.16 14:04 |
| Hallo Woellmi,
alternativ, und das auch noch auf Betriebssystemebene, geht das mit einer named Mutex. Hierzu muss in das Modul mit Sub Main() dieser Code:
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" _
(ByVal lpMutexAttributes As Long, _
ByVal bInitialOwner As Long, _
ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
Long
Private Const ERROR_ALREADY_EXISTS = 183&
Private m_hMutex As Long
Private Const s_NamedMutex As String = "MyExistAppCheck" 'Der Name des Mutex
' ist eigentlich egal,
'soll aber in der App
' unikat sein
Public Sub Main()
m_hMutex = CreateMutex(0&, 1, s_NamedMutex)
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
MsgBox "Das ist der zweite Start der Anwendung"
Exit Sub
End If
MsgBox "Das ist der erste Start der Anwendung"
CloseHandle m_hMutex
'CloaseHandle gibt den Mutex wieder frei, so dass ein dritter Versucht
' wieder
'erfolgreich die App starten kann. Der vierte Versuch wird wieder geblockt
' usw.
End Sub
Beitrag wurde zuletzt am 27.05.16 um 14:05:58 editiert. | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Woellmi | Datum: 28.05.16 00:27 |
| Hi Blackbox,
danke fuer den Code.
"Mutex" ist ein gutes Stichwort. Tatsaechlich verwende ich diesen in meiner Zielapp
(also der, die aufgerufen werden soll) auch um zu verhindern, dass das Prog, wenn
es laeuft deinstalliert werden kann.
Mal sehen, wie ich damit ggf. dem Problem auf die Spur komme.
Da 'effeff' gerade gefragt hat, auch fuer Dich der Hinweis, dass ich in meinem
ersten Posting den Eindruck erweckt habe, dass ich beide Shell-Aufrufe hintereinander
verwende. Sorry, andem ist nicht so. (beide Varianten liefern identisches Verhalten.
Ich werde Deinen Tipp im "aufrufenden" Programm mal testen um festzustellen, ob
dies tatsächlich in Verbindung mit meinem "aufzurufenden" Prog. 2x gestartet wird,
warum auch immer.
Hinweis: werde nicht vor Montag Gelegenheit haben zu testen.
Prima Idee, Danke!
Tschaui
Woellmi | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Blackbox | Datum: 01.06.16 22:22 |
| Hallo Woellmi,
Deine EXE muss den Mutex-Handle im Griff haben.
Das meint: Erst dann wieder freigeben, wenn dieser Prozess
wirklich beendet ist.
CloseHandle m_hMutex
Auch m_hMutex darf zu keiner Zeit überschrieben werden,
sonst snippt die Kernel selbst den Mutex raus, ohne
einen Fehler zu werfen! | |
Re: Start einer externen VB6 Anwendung aus einer VB6 Anwendung | | | Autor: Woellmi | Datum: 02.06.16 22:07 |
| Hi Blackbox,
danke fuer die Hinweise, doch alles hilft nix.
Jetzt habe ich beide Programme bzgl. des Mutex geprueft und einige
Varianten probiert.
- Bei beiden Programmen starte eine "Sub Main"
- Das aufrufende Programm besteht nur aus dieser "Main" und
CloseHandle kommt definitiv erst zum Schluss
- das aufgerufene Problem-Programm verbleibt bis zum Auftreten des "Effektes"
auch nur in der "Sub Main" allerdings wird ein Dialog "Modal" aus
einer ext. ActiveX-DLL aufgerufen, nachdem die Freischaltung ueber sevLock
geklappt hat.
- Mit einem super einfachen Test-VB6 Programm funktioniert auch alles super.
- Was ist nun aber der Unterschied zum Probleme bereitenden Programm?
Struktur des aufrufenden Programmes
[Code]Sub Main()
static nCounter as Long
hMutex=CreateMutex(0&, 1&, "AufrufendesProg")
nCounter = nCounter + 1
If Is2ndProgStarted() Then
MsgBox "Fehler: bitte 2ndProg beenden! (" & Cstr(nCounter) & ")"
Else
Start2ndProg()
End If
CloseHandle hMutex
End SubUnabhaengig vom resultierenden Ablauf, sobald "Start2ndProg()" das Zielprogramm gestartet
hat, kommt die Meldung (MsgBox "Fehler: bitte 2ndProg beenden!")
"nCounter" ist immer "1". Ein Check auf "Previnstance" hilft ebenso wenig.
Das aufgerufene Programm bleibt auch in der "Sub Main"
[Code]Sub Main()
hMutex=CreateMutex(0&,1&,"AufgerufenesProg")
'In jedem Fall liegt eine Lizenzdatei vor!
'..Schalte Prog Ueber Lizenzdatei frei (sevLock)
MsgBox "Prog wurde freigeschaltet"
'..Starte Anmeldedialog
'Eine Dialogbox aus einer ActiveX-DLL öffnet sich
'und verweilt im Anmeldedialog
'Kaum wird dieser angezeigt, erscheint die Meldung des aufrufenden Programmes!
bIsLoginOK = LogInDLL.OpenLoginDLG() '(externe ActiveX DLL)
'Das Ergebnis der Anmeldung wird ausgewertet.
If bIsLoginOK Then
'.. Starte Hauptform
'alles Weitere passiert dann hier.
'"CloseHandle hMutex" wird dann beim "Unload" der Hauptform
'ausgeführt. "hMutex" ist dafür Global veereinbart.
Else
'Destruktor zerstoert alle bestehenden Objekte (DLL's ect.)
CloseHandle hMutex
Exit Sub
End If
End SubDetails sind hier leider schwer unterzubringen. Was ist nun also der Unterschied
zu meinem super einfachen Test-Ziel-Prog?
- Keine DLL's
- Kein sevLock
- Keine Forms
[Code]Sub Main()
hMutex=CreateMutex(0&,1&,"TestAufgerufenesProg")
MsgBox "Test-Prog wurde gestartet"
CloseHandle hMutex
Exit Sub
End SubNa gut, ich bleibe dran und muss mein Org.-Zielprogramm testweise weiter
abrüsten, bis ich eine mgl. Ursache gefunden habe.
Das wird aber noch etwas dauern, da ich hier nur am Rande etwas tun kann.
Also nochmal vielen Dank. Ich melde mich, so ich die Ursache gefunden habe,
bzw. eine Version kreiert habe, die hier einfach aufgezeigt werden kann
um ggf. doch noch von anderer Seite Hilfe zu bekommen.
Bis dahin
Tschaui
Woellmi | |
Warten ... | | | Autor: Blackbox | Datum: 05.06.16 12:10 |
| Hallo Woellmi,
ich schrieb schon: Deine Starter-Exe muss auf das Mutex-Handle aufpassen wie die Henne auf das Ei oder der Hahn auf die Hennen. Dein Probramm schließt das Mutex nämlich sofort nachdem das andere Probramm aufgerufen wurde.
Der Fehler am Beispiel:
Sub Main()
static nCounter as Long
hMutex=CreateMutex(0&, 1&, "AufrufendesProg")
nCounter = nCounter + 1
If Is2ndProgStarted() Then
MsgBox "Fehler: bitte 2ndProg beenden! (" & Cstr(nCounter) & ")"
Else
Start2ndProg()
'Hier fehlt eine Function die verhindert dass der Thread die If-Anweisung
'nicht gleich verlassen kann. Es wird sofort CloseHandle hMutex
' aufgerufen, sofern
'das andere Programm asynchron gestartet wurde. Die Funktionen Shell und
' ShellExecute()
'sind asynchrone Funktionen!
End If
CloseHandle hMutex
End Sub Ich nehme mal an, du nimmst die VB-Shell-Funktion zum Aufruf des externen Programms. Die Syntax dazu ist ja dann:
Dim hProcessID As Long
hProcessID = Shell("NotePad.EXE", 1)
Die Programmausführung setzt, weil Shell() asynchron ist, sofort weiter. Aber Du hast: hProcessID.
Mittels dieser ID lässt sich der Handle des Process erruieren, dass das den über Shell gestarteten
Prozess identifiziert. Das erlaubt, dass man sich über diese ProcessID private Zugriffsrechte auf
den gestarteten Prozess holen kann um, evtl. was Du ja brauchst, den Prozess aus dem asynchronen Lauf
in einen kontrollierten synchronen Lauf zu zwingen. Dazu erbt man mit OpenProcess() einfach einen
Handle:
Dim hProcessID As Long
Dim hProcess As Long
hProcessID = Shell("NotePad.EXE", 1)
hProcess = OpenProcess(PROCESS_SYNCHRONIZE, True, hProcessID)
WaitForSingleObject hProcess, INFINITE
Jetzt wartet man einfach nur darauf, dass hProcess, das ja signalisiert ist auf
einen unsignalisierten Zustand kippt und das genau macht die Funktion: WaitForSingleObject()
Somit synchroner Aufruf eines beliebigen Prozess und warten, bis der beendet ist:
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" _
(ByVal lpMutexAttributes As Long, _
ByVal bInitialOwner As Long, _
ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Const ERROR_ALREADY_EXISTS = 183&
Private Const PROCESS_SYNCHRONIZE = &H100000
Private Const INFINITE As Long = &HFFFFFFFF
Private m_hMutex As Long
Private Const s_NamedMutex As String = "MyExistAppCheck" 'Der Name des Mutex
' ist eigentlich egal,
'soll aber in der App
' unikat sein
Public Sub Main()
Dim hProcessID As Long
Dim hProcess As Long
m_hMutex = CreateMutex(0&, 1, s_NamedMutex)
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
MsgBox "Solange die andere Anwendung läuft kann das Programm nicht" & _
"wieder gestartet werden"
Exit Sub
End If
hProcessID = Shell("NotePad.EXE", 1)
hProcess = OpenProcess(PROCESS_SYNCHRONIZE, True, hProcessID)
'Warten bis der Prozess beendet wurde. VB-Programm startet Notepad.EXE und
'es wird sich hier weiter nichts tun, bis Notepad.EXE geschlossen wurde.
WaitForSingleObject hProcess, INFINITE
MsgBox "Der zweite Prozess wurde geschlossen, jetzt das Mutex und das" & _
"Process-Object freigeben"
CloseHandle hProcess
CloseHandle m_hMutex
End Sub | |
Re: Warten ... (Teil 1) | | | Autor: Woellmi | Datum: 06.06.16 17:47 |
| Hallo Blackbox,
ich bin begeistert von Deinem Einsatz. Ich muss mir Mühe geben alles zu testen,
da ich dieses Projekt aktuell etwas "nebenbei" bearbeiten "darf/muss".
Es gibt noch viele andere Baustellen, die zwar nicht das Kopfzerbrechen bereiten, aber
viel Zeit beanspruchen. (gehört aber alles zusammen)
Nun aber zu meiner "harten Nuss" Ich verstehe was Du meinst und habe es auch sogleich eingebaut.
Damit ich jeden Schritt debuggen und nach aussen hin sichtbar machen kann, habe ich einiges an Overhead dazugebastelt. (sollte aber trotzdem leicht zu finden sein)
da kann mann und werde ich auch einiges einfacher machen, aber gemach.
Was will ich tun/was tue ich aktuell:
- Ich habe ein VB Programm, was mit sevLock freigeschaltet werden soll
(sevLock funktioniert alles prima bis Win10 x64, super Ding!)
- Dazu vertreibe ich neben dem Setup eine Datei "PT32SEVL.KEY" (UNI Setup, Individual KEY-Feile)
- Neben dieser Variante gibt es auch individualisierte Setups
(nur um zu sagen, dass es auch anders geht und ich dies auch tue)
- Da ich die Aktivierungsprozedur im "%CommonAppData% Folder" (normal versteckt)
vornehme, soll das kleine Tool dem Kunden die Arbeit etwas erleichtern.
- Also RegPT32.EXE (das aufrufende Programm) starten und die Aktivierung
wird automatisch vorgenommen, soweit es geht. (Variante UNI-Setup, individual Lizenz)
Variante 1: RegPT32.EXE => starten [Lizenzdatei befindet sich im gleichen Ordner]
Variante 2: RegPT32.EXE "C:\temp\PT32SEVL.KEY" => start mit Parameterübergabe
Variante 3: RegPT32.EXE => keine Angabe zur Lizenzdatei, es oeffnet sich ein dateiauswahldialog.
mit Abruch Möglichkeit
In jedem Fall wird die Lizenzdatei nach "%CommonAppData%\MeineAnwendung" kopiert und
mit dem Start der "aufgerufenen Datei" verarbeitet. (zum Ende hin dann auch gelöscht)
Der Erfolg wird mit einer entsprechenden MsgBox angezeigt. Nach der Bestätigung wechselt
die aufgerufene Anwendung sofort in den Anmeldedialog (für die Nutzeranmeldung)
Wird dieser Anmeldedialog über "Abbruch" verlassen, so wird das aufrufende Programm
auch beendet. (hat also gewartet.
Dies funktioniert nun alles prima. Bis auf den Fakt, dass noch immer die erste Fehlermeldung,
wenn ich diese dann per MsgBox im Fall der Fälle anzeigen lasse noch immer, auch bei Erfolg angezeigt wird.
==> Die grauen Haare werden noch immer mehr
Das Ganze verhält sich aber nur mit meiner Zielanwendung so. (Notepad.exe funkt schon immer prima)
Und ich bin noch immer beim "Abrüsten" und testen.
Und hier der hoffentlich lesbare und nicht zu lange Code, um zu versuchen zu zeigen, was ich tue:
(Die "VB_xxxx" liegen in einer externe DLL, der Name sollte aber hoffentlich 'sprechen')
.. Teil 1
Tschaui
Woellmi | |
Re: Warten ... (Teil 2) | | | Autor: Woellmi | Datum: 06.06.16 17:54 |
| Option Explicit
Public sg__File As String '//Übergabe aus oFr
Private oFrm As frmMain '//Dummy-For
Private n__hMutex As Long
Sub Main()
Dim nCopyResult As Long
Dim sDestKeyFile As String
Dim nMainResult As Long
Dim sFileToStart As String
Dim hProcessID As Long
Dim hProcess As Long
n__hMutex = CreateMutex(0&, 1, "MeinAufrufProgName")
If Err.LastDllError = ERROR_ALREADY_EXISTS Then
'sub_ShowMessage 0& '//Hier die "BÖSE" Meldung ( _
auskommentiert)
Exit Sub
End If
'IsEXERunning => nach Tipp aus vb@rchiv
If IsEXERunning("MeinZielProg") Then
sub_ShowMessage 1& '//Fehlermeldung
Else
'Hier versuche ich es nochmal, ob's Sinn macht?
If App.PrevInstance Then
sub_ShowMessage 0& '//Fehlermeldung
Else
'Startumgebung ermitteln/festlegen
bg_RegistratorOK = False
bg_INIFileExists = False
bg_ExeFileExists = False
bg_KeyFileExists = False
bg_RegisterFile = False
'es wird sich der Installationsort der Aufgerufenen Datei aus einer INI
' geholt,
'welche bei der Installation (InnoSetup) ausgefuellt wird.
'[FileInfo]
'EXEFolder=C:\Prgramme\MeineZielanwendung\
'Keine Registry-Nutzung
sg_PT32AppDataDir = B_GETSPECFOLDER(MEW_SSF_COMMONAPPDATA) & _
"\MeinAppDataFolder\")
sg_AppDIR = VB_GetPath2Dir(App.Path)
sg_PT32INIFile = sg_PT32AppDataDir & "MeineINIDatei.INI"
bg_INIFileExists = VB_FileExistsEx(sg_PT32INIFile)
'Aufrufparameter prüfen (csg_KEYFILENAME = PT32SEVL.KEY)
sg_KeyFile = VB_GetPath2Dir(App.Path) & csg_KEYFILENAME
'wurde ggf. ein Kommandoparameter übergeben?
sg_Command = f_sGetParameterFile(Command)
If sg_Command <> "Error" Then
sg_KeyFile = sg_Command 'z.B.
' C:\Users\ICH\Desktop\PT32SELV.KEY
End If
If bg_INIFileExists Then
sg_PT32EXEFolder = VB_ReadINIStr(csg_INIKEY_EXEFOLDER, _
csg_INISEC_FILEINFO, sg_PT32INIFile)
If Len(sg_PT32EXEFolder) > 0& Then
bg_ExeFileExists = VB_FileExistsEx(VB_GetPath2Dir( _
sg_PT32EXEFolder) & csg_PT32EXENAME)
If bg_ExeFileExists Then
bg_KeyFileExists = VB_FileExistsEx(sg_KeyFile)
If bg_KeyFileExists Then
bg_RegisterFile = True
Else
'Dialog im Hintergrund öffnen ohne angezeigt zu werden.
' Es erscheint nur der Eingabedialog
Set oFrm = New frmMain
oFrm.Show
Unload oFrm
Set oFrm = Nothing
If sg__File <> "Canceled" Then
sg_KeyFile = sg__File
bg_KeyFileExists = VB_FileExistsEx(sg_KeyFile)
If bg_KeyFileExists Then
bg_RegisterFile = True
Else
sub_ShowMessage 2&
End If
Else
sub_ShowMessage 3&
End If
End If
Else
sub_ShowMessage 4&
End If
Else
sub_ShowMessage 5&
End If
Else
sub_ShowMessage 6&
End If
If bg_RegisterFile Then
sDestKeyFile = VB_GetPath2Dir(VB_GetPath2Dir( _
VB_GETSPECFOLDER(MEW_SSF_COMMONAPPDATA)) & _
csg_PT32APPDATAFOLDER) & csg_KEYFILENAME
nCopyResult = CopyFile(sg_KeyFile, sDestKeyFile, 0&)
If VB_FileExistsEx(sDestKeyFile) Then
sFileToStart = VB_GetPath2Dir(sg_PT32EXEFolder) & csg_PT32EXENAME
If Len(sFileToStart) > 0& And VB_FileExistsEx(sFileToStart) Then
hProcessID = Shell(sFileToStart, vbNormalFocus)
If hProcessID > 0& Then
hProcess = OpenProcess(PROCESS_SYNCHRONIZE, True, hProcessID)
'Warten bis der Prozess beendet wurde. VB-Programm startet
' ZielProg und
'es wird sich hier weiter nichts tun, bis das ZielProg
' geschlossen wurde.
WaitForSingleObject hProcess, INFINITE
'Hier wird erst dann weitergemacht, wenn die ZielProg
' beendet wurde.
sub_ShowMessage 100& '//Alles OK, fertig
Else
sub_ShowMessage 7&
End If
Else
sub_ShowMessage 8&
End If
Else
sub_ShowMessage 9&
End If
End If
End If
End If
If hProcess <> 0& Then: CloseHandle hProcess
CloseHandle n__hMutex
Exit Sub
End Sub .. Teil 2
Tschaui
Woellmi | |
Re: Warten ... (Teil 3) | | | Autor: Woellmi | Datum: 06.06.16 17:59 |
| Private Sub sub_ShowMessage(ByVal nMsg As Long)
Dim sPrompt As String
Dim sTitle As String
Dim nKeys As String
Select Case nMsg
Case 0&: '.. Fehler 0
sPrompt = "..."
nKeys = vbInformation + vbOKOnly
sTitle = "..."
'...
Case 100&
sPrompt = "OK, Aktiviert."
nKeys = vbInformation + vbOKOnly
sTitle = App.Title
End Select
MsgBox sPrompt, nKeys, sTitle
End Sub Private Function f_sGetParameterFile(ByVal s_CMD As String) As String
Dim nIdx As Long
Dim asgCMDs() As String
Dim nNumOfCMDs As Long
Dim sData As String
'Lizenzdatei im Parameter?
f_sGetParameterFile = "Error"
If Len(s_CMD) > 0 Then
asgCMDs = Split(s_CMD, """")
nNumOfCMDs = UBound(asgCMDs) + 1&
For nIdx = 0 To nNumOfCMDs - 1&
sData = asgCMDs(nIdx)
asgCMDs(nIdx) = VB_Remove(sData, """")
If InStr(UCase(asgCMDs(nIdx)), UCase(csg_KEYFILENAME)) > 0& Then
f_sGetParameterFile = asgCMDs(nIdx)
Exit For
End If
Next nIdx
End If
End Function Global Const OFN_ALLOWMULTISELECT As Long = &H200
Global Const OFN_CREATEPROMPT As Long = &H2000
Global Const OFN_EXPLORER As Long = &H80000
Global Const OFN_EXTENSIONDIFFERENT As Long = &H400
Global Const OFN_FILEMUSTEXIST As Long = &H1000
Global Const OFN_HelpButton As Long = &H10
Global Const OFN_HIDEREADONLY As Long = &H4
Global Const OFN_LONGNAMES As Long = &H200000
Global Const OFN_NOCHANGEDIR As Long = &H8
Global Const OFN_NODEREFERENCELINKS As Long = &H100000
Global Const OFN_NOLONGNAMES As Long = &H40000
Global Const OFN_NOREADONLYRETURN As Long = &H8000
Global Const OFN_NOVALIDATE As Long = &H100
Global Const OFN_OVERWRITEPROMPT As Long = &H2
Global Const OFN_PATHMUSTEXIST As Long = &H800
Global Const OFN_READONLY As Long = &H1
Global Const OFN_SHAREAWARE As Long = &H4000
Global Const OFS_FILE_OPEN_FLAGS As Long = OFN_EXPLORER Or OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS
'Dateiauswahldialog
Type OPENFILENAME
nStructSize As Long
hwndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nCustFilterSize As Long
nFilterIndex As Long
sFile As String
nFileSize As Long
sFileTitle As String
nTitleSize As Long
sInitDir As String
sDlgTitle As String
flags As Long
nFileOffset As Integer
nFileExt As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Function fkt_sDelectKeyFile(Optional sPath As String) As String
Dim sFilter As String
Dim uOFN As OPENFILENAME
uOFN.nStructSize = Len(uOFN)
uOFN.hwndOwner = GetActiveWindow()
sFilter = "Mein Key-File(PT32SEVL.key)" & vbNullChar & "PT32SEVL.key" & _
vbNullChar
sFilter = sFilter & vbNullChar & vbNullChar
uOFN.sFilter = sFilter
uOFN.nFilterIndex = 1
uOFN.sDlgTitle = "Key File not automatically found. Please select manually:"
uOFN.flags = OFS_FILE_OPEN_FLAGS
uOFN.sFile = Space$(256) & vbNullChar
uOFN.nFileSize = Len(uOFN.sFile)
uOFN.sFileTitle = Space$(256) & vbNullChar
uOFN.nTitleSize = Len(uOFN.sFileTitle)
If Not IsMissing(sPath) Then
uOFN.sInitDir = sPath
End If
If GetOpenFileName(uOFN) Then
fkt_sDelectKeyFile = Left(uOFN.sFile, InStr(uOFN.sFile, vbNullChar) - 1)
Else
fkt_sDelectKeyFile = "Canceled"
End If
End Function 'Meine Geisterform:
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
sg__File = fkt_sDelectKeyFile(App.Path)
Me.Hide
End Sub Ich setze die kleine App nun auch aktuell ein, muss aber auf die erste Fehlermeldung
verzichten. Kann aber damit aktuell leben!!
Trotzdem habe ich noch immer ein totales "Schwarzes Loch" im Geiste bzgl. des speziellen
Verhaltens.
Ich bleibe dran und melde mich, sobald ich eine 100% Lösung gefunden habe.
Ich finde es echt toll, wie hier geholfen wird: Dickes Danke an Blackbox.
Ich hoffe meine Codeauszuege sind nicht zu verwirrend. Wie gesagt ich habe hier
mehr Augenmerk auf Fortschrittsverfolgung als auf Eleganz gelegt.
Viele Gruesse
Tschaui
Woellmi | |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
vb@rchiv CD Vol.6 vb@rchiv Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion Entwickler-Vollversionen u.v.m.Jetzt zugreifen Tipp des Monats Neu! sevCoolbar 3.0
Professionelle Toolbars im modernen Design!
Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Weitere Infos
|