| ActiveX-EXE, Klassenmodul, Instanzen einer Anwendung |
| |
| |
| Sub Form_Load() | |
| Top = 0 | |
| Left = Screen.Width - Width | |
| End Sub | |
| |
| '-------- Lesen des Tags ---------------------- | |
| Sub File1_Click() | |
| cmdKillOneTag.Visible = False | |
| Call ReadMyFiles | Einzelnen MP3-Tag teilweise lesen und in TextBoxen schreiben. |
| If txtArtist <> "" Or txtTitle <> "" Or txtAlbum <> "" Or _ |  |
| txtYear <> "" Or txtGenreCode <> "255" Or txtComment <> "" Then | |
| cmdKillOneTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub Dir1_Change() | |
| File1.FileName = Dir1.Path | |
| Call EraseTXTBoxes | |
| cmdWriteTag.Visible = False | |
| cmdKillOneTag.Visible = False | |
| If File1.ListCount > 1 Then | |
| cmdSerie.Visible = True | |
| cmdKillTag.Visible = True | |
| Else | |
| cmdSerie.Visible = False | |
| cmdKillTag.Visible = False | |
| End If | |
| End Sub | |
| |
| Sub Dir1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) |
| File1.ListIndex = -1 | |
| Call Dir1_Change | |
| End Sub | |
| |
| Sub File1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) |
| If File1.ListCount > 0 Then | |
| File1.ToolTipText = " Artist & Songname: Use Drag & Drop !!! " |
| End If | |
| End Sub | |
| |
| Sub Drive1_Change() | |
| Dim HelpStr$ | |
| HelpStr = Clipboard.GetText() | |
| On Error GoTo Meldung 'Wenn Laufwerk nicht ansprechbar dann Fehlermeldung |
| If HelpStr <> "" Then | |
| On Error GoTo 100 | |
| Dir1.Path = Clipboard.GetText() | |
| Drive1.Drive = Clipboard.GetText() | |
| On Error GoTo 0 | |
| Else | |
| 100: | |
| Dir1.Path = Drive1.Drive 'Wählt ein Laufwerk in der DriveListBox aus |
| File1.FileName = Dir1.Path | |
| End If | |
| cmdWriteTag.Visible = False | |
| cmdKillOneTag.Visible = False | |
| Exit Sub 'Wenn Laufwerk ansprechbar, übergehe Fehlermeldung |
| Meldung: | |
| Select Case MsgBox(Err.Description, 37, "Error No. " & Err.Number) |
| Case 2 'Programm-Exit | |
| Resume Next | |
| Case 4 'Befehl wiederholen | |
| Resume | |
| End Select | |
| End Sub | |
| |
| '-------- Schreiben eines Tags ---------------------- | |
| Sub cmdWriteTag_Click() | |
| Call WriteMyMP3 | |
| Call ReadMyFiles | |
| End Sub | |
| |
| '-------- Schreiben der Tags in Serie ------------- | |
| Sub cmdSerie_Click() | |
| Call WriteAllMP3s | |
| End Sub | |
| |
| '-------- Löschen eines Tags ------------- | |
| Sub cmdKillOneTag_Click() | |
| Call KillOneTag | |
| Call ReadMyFiles | |
| End Sub | |
| |
| '-------- Löschen der Tags in Serie ------------- | |
| Sub cmdKillTag_Click() | |
| Call KillAllMP3Tags | |
| End Sub | |
| |
| Sub txtAlbum_Change() | |
| If File1.FileName = "" Then | |
| cmdWriteTag.Visible = False | |
| Else | |
| cmdWriteTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub txtAlbum_KeyDown(KeyCode As Integer, Shift As Integer) | |
| If KeyCode = 13 Then txtYear.SetFocus | |
| End Sub | |
| |
| Sub txtAlbum_KeyPress(KeyAscii As Integer) | |
| If File1.FileName = "" Then KeyAscii = 0 | |
| End Sub | |
| |
| Sub txtArtist_Change() | |
| If File1.FileName = "" Then | |
| cmdWriteTag.Visible = False | |
| Else | |
| cmdWriteTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub txtArtist_KeyDown(KeyCode As Integer, Shift As Integer) |
| If KeyCode = 13 Then txtTitle.SetFocus | |
| End Sub | |
| |
| Sub txtArtist_KeyPress(KeyAscii As Integer) | |
| If File1.FileName = "" Then KeyAscii = 0 | |
| End Sub | |
| |
| Sub txtArtist_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) |
| If Not File1.FileName = "" Then | |
| Call Bindestrich_checken(Temp_Artist, Temp_Title) | |
| txtArtist.Text = Temp_Artist | |
| txtTitle.Text = Temp_Title | |
| End If | |
| End Sub | |
| |
| Sub txtComment_Change() | |
| If File1.FileName = "" Then | |
| cmdWriteTag.Visible = False | |
| Else | |
| cmdWriteTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub txtComment_KeyDown(KeyCode As Integer, Shift As Integer) |
| If KeyCode = 13 Then txtArtist.SetFocus | |
| End Sub | |
| |
| Sub txtComment_KeyPress(KeyAscii As Integer) | |
| If File1.FileName = "" Then KeyAscii = 0 | |
| End Sub | |
| |
| Sub txtGenreCode_Change() | |
| If File1.FileName = "" Then | |
| cmdWriteTag.Visible = False | |
| Else | |
| cmdWriteTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub txtGenreCode_KeyDown(KeyCode As Integer, Shift As Integer) |
| If KeyCode = 13 Then txtComment.SetFocus | |
| End Sub | |
| |
| Sub txtGenreCode_KeyPress(KeyAscii As Integer) |
| If File1.FileName = "" Then KeyAscii = 0 | |
| Select Case Chr(KeyAscii) | |
| Case "0" To "9" | |
| Case Chr(vbKeyBack) | |
| Case Else | |
| KeyAscii = 0 | |
| End Select | |
| End Sub | |
| |
| Sub txtTitle_Change() | |
| If File1.FileName = "" Then | |
| cmdWriteTag.Visible = False | |
| Else | |
| cmdWriteTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub txtTitle_KeyDown(KeyCode As Integer, Shift As Integer) |
| If KeyCode = 13 Then txtAlbum.SetFocus | |
| End Sub | |
| |
| Sub txtTitle_KeyPress(KeyAscii As Integer) | |
| If File1.FileName = "" Then KeyAscii = 0 | |
| End Sub | |
| |
| Sub txtTitle_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) |
| If Not File1.FileName = "" Then | |
| Call Bindestrich_checken(Temp_Artist, Temp_Title) | |
| txtArtist.Text = Temp_Artist | |
| txtTitle.Text = Temp_Title | |
| End If | |
| End Sub | |
| |
| Sub txtYear_Change() | |
| If File1.FileName = "" Then | |
| cmdWriteTag.Visible = False | |
| Else | |
| cmdWriteTag.Visible = True | |
| End If | |
| End Sub | |
| |
| Sub txtYear_KeyDown(KeyCode As Integer, Shift As Integer) |
| If KeyCode = 13 Then txtGenreCode.SetFocus | |
| End Sub | |
| |
| Sub txtYear_KeyPress(KeyAscii As Integer) | |
| If File1.FileName = "" Then KeyAscii = 0 | |
| Select Case Chr(KeyAscii) | |
| Case "0" To "9" | |
| Case Chr(vbKeyBack) | |
| Case Else | |
| KeyAscii = 0 | |
| End Select | |
| End Sub | |
| |
| Sub cmdEnd_Click() | |
| Clipboard.Clear | |
| Unload Me | |
| End Sub | |
| |
| Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) |
| Clipboard.Clear | |
| End Sub | |
| |
| Function Bindestrich_checken(Temp_Artist, Temp_Title) |
| On Error GoTo ende | |
| Temp_Artist = "": Temp_Title = "": Temp_File = "" |
| Temp_File = Trim(Left(File1.FileName, Len(File1.FileName) - 4)) |
| Temp_Artist = Trim(Left$(Temp_File, InStr(1, Temp_File, "-") - 1)) |
| Temp_Title = Trim(Right$(Temp_File, Len(Temp_File) - InStr(1, Temp_File, "-"))) |
| Exit Function | |
| ende: | |
| MsgBox "FileName has no hyphen - ", vbCritical, "Error" |
| Temp_Artist = "": Temp_Title = "": Temp_File = "" |
| End Function | |
| |
| Public CurrentTag As TagInfo, FileName$, Tempp$ | |
| Public Temp_Artist$, Temp_Title$, Temp_File$ | |
| Public f As frmMP3 | |
| |
| Public Type TagInfo | |
| tag As String * 3 | |
| songname As String * 30 | |
| artist As String * 30 | |
| album As String * 30 | |
| year As String * 4 | |
| comment As String * 30 | |
| genre As String * 1 | |
| End Type | |
| |
| Public Sub Main() | |
| Dim OldTitle$ | |
| If App.PrevInstance Then | |
| OldTitle = App.Title | |
| App.Title = "SampleToDelete" | |
| AppActivate OldTitle | |
| End | |
| Else | |
| Set f = frmMP3 | |
| If App.StartMode = vbSModeStandalone Then | |
| f.Show | |
| End If | |
| End If | |
| End Sub | |
| |
| Function ReadMyFiles() | Einzelnen MP3-Tag lesen. |
| On Error Resume Next | |
| f.cmdSerie.Visible = False | |
| f.cmdKillTag.Visible = False | |
| Call EraseTXTBoxes | |
| If Right(f.Dir1.Path, 1) = "\" Then | |
| FileName = f.Dir1.Path & f.File1.FileName | |
| Else | |
| FileName = f.Dir1.Path & "\" & f.File1.FileName | |
| End If | |
| Open FileName For Binary As #1 | |
| With CurrentTag | |
| Get #1, FileLen(FileName) - 127, .tag | |
| If Not .tag = "TAG" Then | |
| f.txtArtist.Text = "N o T a g !" | |
| Close #1 | |
| Exit Function | |
| End If | |
| Get #1, , .songname | |
| Get #1, , .artist | |
| Get #1, , .album | |
| Get #1, , .year | |
| Get #1, , .comment | |
| Get #1, , .genre | |
| Close #1 | |
| f.txtArtist = RTrim(.artist) | |
| f.txtTitle = RTrim(.songname) | |
| f.txtAlbum = RTrim(.album) | |
| f.txtYear = RTrim(.year) | |
| f.txtComment = RTrim(.comment) | |
| Tempp = RTrim(.genre) | |
| f.txtGenreCode = Asc(Tempp) | |
| ' f.Combo1.ListIndex = CInt(txtGenreCode) - 1 | |
| End With | |
| f.cmdWriteTag.Visible = False | |
| Tempp = "" | |
| End Function | |
| |
| Public Sub EraseTXTBoxes() | |
| f.txtTitle.Text = vbNullString | |
| f.txtArtist.Text = vbNullString | |
| f.txtAlbum.Text = vbNullString | |
| f.txtYear.Text = vbNullString | |
| f.txtComment.Text = vbNullString | |
| End Sub | |
| |
| Function WriteMyMP3() | Einen MP3-Tag schreiben. |
| Dim yearr% | |
| If Right(f.Dir1.Path, 1) = "\" Then | |
| FileName = f.Dir1.Path & f.File1.FileName | |
| Else | |
| FileName = f.Dir1.Path & "\" & f.File1.FileName | |
| End If | |
| If Not f.txtYear.Text = vbNullString Then yearr = f.txtYear.Text |
| If yearr = 0 Then | |
| If f.txtYear.Text = vbNullString Then GoTo save1 | |
| MsgBox "Put the year between 1900 and 2100... and try again! ", vbCritical, "MP3-Tag Save Error" |
| f.txtYear.SetFocus | |
| f.txtYear.SelStart = 0 | |
| f.txtYear.SelLength = Len(f.txtYear.Text) | |
| Exit Function | |
| End If | |
| save1: | |
| If yearr < 1900 Or yearr > 2100 Then | |
| If f.txtYear.Text = vbNullString Then GoTo save2 | |
| MsgBox "Put the year between 1900 and 2100... and try again! ", vbCritical, "MP3-Tag Save Error" |
| f.txtYear.SetFocus | |
| f.txtYear.SelStart = 0 | |
| f.txtYear.SelLength = Len(f.txtYear.Text) | |
| Exit Function | |
| End If | |
| save2: | |
| If f.txtTitle.Text = "" Or f.txtArtist.Text = "" Then | |
| MsgBox "No entry for Artist or Songname...! ", vbCritical, "MP3-Tag Save Error" |
| Else | |
| If f.File1.FileName = "" Then Exit Function | |
| With CurrentTag | |
| .tag = "TAG" | |
| .songname = f.txtTitle | |
| .artist = f.txtArtist | |
| .album = f.txtAlbum | |
| .year = f.txtYear | |
| .comment = f.txtComment | |
| '' .genre = Chr(f.Combo1.ListIndex + 1) | |
| .genre = Chr("255") 'erzeugt keinen Eintrag | |
| On Error GoTo Meldung | |
| Open FileName For Binary Access Write As #1 | |
| Seek #1, FileLen(FileName) - 127 | |
| Put #1, , .tag | |
| Put #1, , .songname | |
| Put #1, , .artist | |
| Put #1, , .album | |
| Put #1, , .year | |
| Put #1, , .comment | |
| Put #1, , .genre | |
| Close #1 | |
| End With | |
| End If | |
| On Error GoTo 0 | |
| f.txtArtist.SetFocus | |
| f.cmdWriteTag.Visible = False | |
| Exit Function | |
| Meldung: | |
| MsgBox "You can't save to an open file...! ", vbCritical, "MP3-Tag Save Error" |
| Exit Function | |
| End Function | |
| |
| Function WriteAllMP3s() | Alle MP3-Tags im Verzeichnis schreiben. |
| Dim i&, i2&, FileNam() | |
| i = 0: i2 = 0 | |
| Select Case MsgBox("Program will take 'Artist' and 'Songname' from Filename! " & vbCrLf _ |
| & "Please close all Files in WinAmp and De-Select Files in Explorer... " _ |
| & vbCrLf & vbCrLf & "Write all Files in this Directory? ", _ |
| vbQuestion + vbYesNo + vbDefaultButton2, "Write All Files?") |
| Case vbYes | |
| For i = 0 To f.File1.ListCount - 1 | |
| 10: | |
| ReDim Preserve FileNam(1 To i + 1) | |
| FileNam(i + 1) = f.File1.List(i) | |
| If Right(f.Dir1.Path, 1) = "\" Then | |
| FileNam(i + 1) = f.Dir1.Path & f.File1.List(i) | |
| Else | |
| FileNam(i + 1) = f.Dir1.Path & "\" & f.File1.List(i) | |
| End If | |
| If FileNam(i + 1) = "" Then Exit Function | |
| On Error GoTo error_counter | |
| With CurrentTag | |
| Temp_Artist = "": Temp_Title = "": Temp_File = "" |
| Temp_File = Trim(Left(f.File1.List(i), Len(f.File1.List(i)) - 4)) |
| Temp_Artist = Left$(Temp_File, InStr(1, Temp_File, "-") - 1) |
| Temp_Title = Right$(Temp_File, (Len(f.File1.List(i)) - 4) - (InStr(1, Temp_File, "-"))) |
| .tag = "TAG" | |
| .songname = LTrim(Temp_Title) | |
| .artist = RTrim(Temp_Artist) | |
| .album = vbNullString | |
| .year = vbNullString | |
| .comment = vbNullString | |
| .genre = Chr("255") 'erzeugt keinen Eintrag | |
| Open FileNam(i + 1) For Binary Access Write As #1 | |
| Seek #1, FileLen(FileNam(i + 1)) - 127 | |
| Put #1, , .tag | |
| Put #1, , .songname | |
| Put #1, , .artist | |
| Put #1, , .album | |
| Put #1, , .year | |
| Put #1, , .comment | |
| Put #1, , .genre | |
| Close #1 | |
| On Error GoTo 0 | |
| End With | |
| Next i | |
| End Select | |
| If i2 = 0 And i > 0 Then | |
| MsgBox i & " MP3-Tags Saved! ", vbInformation, "MP3-Tags Saved" |
| ElseIf i2 > 0 Then | |
| MsgBox "You can't save " & i2 & " file(s)...! ", vbCritical, "MP3-Tag Save Error" |
| End If | |
| f.txtArtist.SetFocus | |
| f.cmdWriteTag.Visible = False | |
| f.cmdSerie.Visible = False | |
| f.cmdKillTag.Visible = False | |
| Exit Function | |
| error_counter: | |
| i2 = i2 + 1 | |
| i = i + 1 | |
| GoTo 10 | |
| End Function | |
| |
| Function KillOneTag() | Einen MP3-Tag löschen. |
| If Right(f.Dir1.Path, 1) = "\" Then | |
| FileName = f.Dir1.Path & f.File1.FileName | |
| Else | |
| FileName = f.Dir1.Path & "\" & f.File1.FileName | |
| End If | |
| If f.File1.FileName = "" Then Exit Function | |
| With CurrentTag | |
| .tag = vbNullString | |
| .songname = vbNullString | |
| .artist = vbNullString | |
| .album = vbNullString | |
| .year = vbNullString | |
| .comment = vbNullString | |
| ' .genre = Chr(f.Combo1.ListIndex + 1) | |
| .genre = Chr("255") 'erzeugt keinen Eintrag | |
| On Error GoTo Meldung | |
| Open FileName For Binary Access Write As #1 | |
| Seek #1, FileLen(FileName) - 127 | |
| Put #1, , .tag | |
| Put #1, , .songname | |
| Put #1, , .artist | |
| Put #1, , .album | |
| Put #1, , .year | |
| Put #1, , .comment | |
| Put #1, , .genre | |
| Close #1 | |
| End With | |
| On Error GoTo 0 | |
| f.txtArtist.SetFocus | |
| f.cmdWriteTag.Visible = False | |
| f.cmdKillOneTag.Visible = False | |
| Exit Function | |
| Meldung: | |
| MsgBox "You can't save to an open file...! ", vbCritical, "MP3-Tag Save Error" |
| Exit Function | |
| End Function | |
| |
| Function KillAllMP3Tags() | Alle MP3-Tags im Verzeichnis löschen. |
| Dim i&, i2&, FileNam() | |
| i = 0: i2 = 0 | |
| Select Case MsgBox("Program will k i l l all Tags from File! " & vbCrLf _ |
| & "Please close all Files in WinAmp and De-Select Files in Explorer... " _ |
| & vbCrLf & vbCrLf & "Kill all Tags in this Directory? ", _ |
| vbQuestion + vbYesNo + vbDefaultButton2, "Kill All Tags?") |
| Case vbYes | |
| For i = 0 To f.File1.ListCount - 1 | |
| 10: | |
| ReDim Preserve FileNam(1 To i + 1) | |
| FileNam(i + 1) = f.File1.List(i) | |
| If Right(f.Dir1.Path, 1) = "\" Then | |
| FileNam(i + 1) = f.Dir1.Path & f.File1.List(i) | |
| Else | |
| FileNam(i + 1) = f.Dir1.Path & "\" & f.File1.List(i) | |
| End If | |
| If FileNam(i + 1) = "" Then Exit Function | |
| On Error GoTo error_counter | |
| With CurrentTag | |
| .tag = vbNullString | |
| .songname = vbNullString | |
| .artist = vbNullString | |
| .album = vbNullString | |
| .year = vbNullString | |
| .comment = vbNullString | |
| .genre = Chr("255") 'erzeugt keinen Eintrag | |
| Open FileNam(i + 1) For Binary Access Write As #1 | |
| Seek #1, FileLen(FileNam(i + 1)) - 127 | |
| Put #1, , .tag | |
| Put #1, , .songname | |
| Put #1, , .artist | |
| Put #1, , .album | |
| Put #1, , .year | |
| Put #1, , .comment | |
| Put #1, , .genre | |
| Close #1 | |
| On Error GoTo 0 | |
| End With | |
| Next i | |
| End Select | |
| If i2 = 0 And i > 0 Then | |
| MsgBox i & " MP3-Tags Killed! ", vbInformation, "MP3-Tags Killed" |
| ElseIf i2 > 0 Then | |
| MsgBox "You can't save " & i2 & " file(s)...! ", vbCritical, "MP3-Tag Save Error" |
| End If | |
| f.txtArtist.SetFocus | |
| f.cmdWriteTag.Visible = False | |
| f.cmdSerie.Visible = False | |
| f.cmdKillTag.Visible = False | |
| Exit Function | |
| error_counter: | |
| i2 = i2 + 1 | |
| i = i + 1 | |
| GoTo 10 | |
| End Function | |
| |
| Klassenmodul: | |
| Private Sub Class_Initialize() | |
| If Forms.Count = 0 Then | |
| Load frmMP3 | |
| End If | |
| With frmMP3 | |
| If .WindowState = vbMinimized Then | |
| .WindowState = vbNormal | |
| End If | |
| .Show | |
| End With | |
| End Sub | |
| |
| Public Function MP3Start(Params As String) As Variant | |
| On Error GoTo weiter | |
| frmMP3.Dir1.Path = Clipboard.GetText() | |
| frmMP3.Drive1.Drive = Clipboard.GetText() | |
| Exit Function | |
| weiter: | |
| On Error Resume Next | |
| frmMP3.Dir1.Path = "C:\" | |
| frmMP3.Drive1.Drive = "C:\" | |
| End Function | |
| |
| Starter-EXE: | |
| Public Sub Main() | |
| Dim Instanz As ReadWriteMP3.MP3Instanz | |
| Set Instanz = New ReadWriteMP3.MP3Instanz | |
| With New ReadWriteMP3.MP3Instanz | |
| .MP3Start Command$ | |
| End With | |
| End Sub | |
| |
| |
| Instanzen eines Formulars | |
|
| Die Eigenschaft PrevInstance des App-Objekts teilt mit, ob bereits weitere Instanzen einer Anwendung laufen. Wenn man nun bei |
| einem erneuten Start einer Anwendung eine solche vorhergehende Instanz lediglich aktivieren möchten, anstatt die Anwendung |
| zum zweiten Mal auszuführen, bedarf es einiger Kunstgriffe. Visual Basic hält dazu keine eigenen Bordmittel bereit. |
|
| Eine bekannte Möglichkeit ist, über eine Reihe von API-Funktionen ein Fenster (Form) der vorhergehenden Instanz ausfindig zu machen |
| und zu aktivieren, und es gegebenenfalls wiederherzustellen, falls es minimiert sein sollte. In der Regel funktioniert dies auch ganz gut. |
| Allzu sicher ist das Verfahren jedoch nicht, da zwischen der bereits laufenden Instanz und der sich um die Reaktivierung derselben |
| bemühenden neuen Instanz keinerlei direkte Beziehung besteht. Zum einen kann man unabsichtlich eine völlig andere Anwendung |
| reaktivieren, falls zufällig verschiedene Namensübereinstimmungen zur eigenen Anwendung bestehen sollten. |
|
| Zum anderen kann die neue Instanz nichts über den Zustand der laufenden Anwendung wissen. Sie kann vielleicht vergeblich nach dem zu |
| reaktivierenden Form suchen, während dieses gar nicht geladen ist. Oder dieses Form ist zufällig gesperrt, weil der Anwender gerade ein |
| anderes Form der Anwendung modal geöffnet hat. Je nach Komplexität Ihrer Anwendung können weitere Unwägbarkeiten hinzukommen, |
| über die sich die neu startende Instanz nur mit (für VB-Verhältnisse) recht hohem Aufwand über API-Mechanismen informieren könnte. |
| Auch ist eine gezielte Kommunikation zwischen den beiden Instanzen, etwa Übergabe der Kommandozeilen-Parameter der neuen |
| Instanz an die alte und dergleichen, nicht so einfach zu erreichen. |
|
| Mit nur minimalem Aufwand kann man hingegen über ActiveX einen sicheren und sehr flexiblen Mechanismus etablieren, mit |
| direkter Verständigung zwischen der laufenden und jeder neu hinzukommenden Instanz. Und natürlich mit problemloser Übergabe |
| der Kommandozeilen-Parameter von der neuen an die laufende Instanz. |
|
| Dazu verwandelt man die eigentliche Anwendung in eine ActiveX-EXE und schalten eine kleine Starter-Anwendung (weiterhin |
| eine gewöhnliche Standard-EXE) vor. |
| Diese Starter-EXE erweckt die ActiveX-EXE beim ihrem ersten Aufruf zum Leben. Bei jedem weiteren Aufruf reaktiviert sie nur noch |
| die bereits laufende Instanz der ActiveX-EXE, und kann mit ihr beliebig Informationen austauschen oder Anweisungen an sie absetzen. |
|
| Die zur ActiveX-EXE mutierte Anwendung (die wir hier ReadWriteMP3 nennen) benötigt zusätzlich nichts weiter, als eine öffentliche |
| und instanzierbare Klasse, die wir hier MP3Instanz nennen. Diese Klasse braucht noch nicht einmal über Methoden und |
| Eigenschaften zu verfügen. Lediglich eine Class_Initialize-Prozedur wird benötigt. In dieser lädt man das Hauptform der Anwendung, |
| falls es noch nicht geladen sein sollte. Und hier reaktiviert man es und stellt es wieder her, falls es minimiert sein sollte. |
 | |
| |
| Private Sub Class_Initialize() | |
| If Forms.Count = 0 Then | |
| Load Form1 | |
| End If | |
| With Form1 | |
| If .WindowState = vbMinimized Then | |
| .WindowState = vbNormal | |
| End If | |
| .Show | |
| End With | |
| End Sub | |
| |
| |
| Die Starter-EXE besteht nur aus einem Standard-Modul mit einer Sub Main-Prozedur. |
| Dazu nimmt man einen Verweis auf die ActiveX-EXE-Anwendung auf: |
| Die (ActiveX)-ReadWriteMP3.exe wird zuerst ins Verzeichnis C:\WINNT kompiliert ! |
| Die Starter.exe erhält dann einen Verweis auf die ReadWriteMP3.exe und wird ebenfalls ins Verzeichnis C:\WINNT kompiliert. |
| |
| Es ist zu beachten, dass die Klasse Instance separat deklariert und instanziert werden muss. |
| |
| Bei einer Deklaration wie | |
| Dim Instanz As New Instanz | |
| würde nämlich nicht sofort deren Class_Initialize-Prozedur aufgerufen, sondern erst bei einem Zugriff auf eine Methode oder |
| Eigenschaft der Klasse - über die diese nicht verfügt. |
| |
| Public Sub Main() | |
| Dim Instanz As ReadWriteMP3.MP3Instanz | |
| Set Instanz = New ReadWriteMP3.MP3Instanz | |
| End Sub | |
| |
| Das war nun auch schon alles. Der einzige Unterschied zur früher "normalen" Anwendung besteht darin, dass der Anwender |
| diese nicht mehr direkt startet, sondern statt dessen nur noch die Starter-EXE. |
| |
| Falls es jedoch weiterhin möglich sein soll, ganz bewusst eine zweite Instanz der Anwendung zu starten, ruft man die Starter-EXE |
| mit einem Kommandozeilen-Parameter (beispielsweise "/X") auf. In der Sub Main-Prozedur ruft man also die ActiveX-EXE als |
| Standalone-Anwendung auf (beide EXEs sollten sich der Einfachheit halber im gleichen Verzeichnis befinden). |
| |
| Public Sub Main() | |
| Dim nInstance As Instance | |
| If UCase$(Command$) = "/X" Then | |
| Shell "Anwendung.exe", vbNormalFocus | |
| Else | |
| Set nInstance = New Instance | |
| End If | |
| End Sub | |
| |
| Damit auch dann das Hauptform der Anwendung geladen und angezeigt wird, braucht nun auch die ActiveX-EXE ein |
| Standard-Modul mit einer Sub Main-Prozedur. |
| |
| Public Sub Main() | |
| If App.StartMode = vbSModeStandalone Then ' wird in den Projekteigenschaften der ActiveX-EXE festgelegt |
| Form1.Show | |
| End If | |
| End Sub | |
| |
| Bis jetzt fehlt allerdings noch die Möglichkeit des Informationsaustauschs zwischen der als ActiveX-EXE laufenden Anwendung |
| und einer später gestarteten Starter-EXE. |
| Eine wie bisher sozusagen "stumme" Verbindungsklasse braucht ja schließlich nicht zu sein. Man kann die Klasse Instances mit |
| einer Methode (die wir hier MP3Start nennen) versehen, der man die Kommandozeile als Parameter übergibt. In dieser Methode |
| hat man vollen Zugriff auf die Anwendung - über die Forms-Collection auf alle geladenen Forms und auf globale Variablen. |
| Hier kann man nach Herzenslust die Kommandozeile auswerten und anstellen, was immer man will: |
| |
| Public Function MP3Start(Params As String) As Variant |
| frmMP3.Dir1.Path = Clipboard.GetText() 'hier: Werte aus der Zwischenablage übergeben |
| frmMP3.Drive1.Drive = Clipboard.GetText() 'Visual Basic hat ein Clipboard-Objekt |
| End Sub | |
| |
| Man kann auch den bisherigen Inhalt der Class_Initialize-Prozedur hierher verschieben und so etwa gegebenenfalls |
| anhand der übergebenen Kommandozeile entscheiden, welches Form (re)aktiviert werden soll. So kann man auch schon |
| beim ersten Start die Kommandozeile nach Belieben auswerten. |
| |
| In der Sub Main-Prozedur ruft man zusätzlich diese Methode auf: |
| Public Sub Main() | |
| Dim Instanz As ReadWriteMP3.MP3Instanz | |
| Set Instanz = New ReadWriteMP3.MP3Instanz | |
| If UCase$(Command$) = "/X" Then | |
| Shell "Anwendung.exe", vbNormalFocus | |
| Else | |
| With New ReadWriteMP3.MP3Instanz | |
| .MP3Start Command$ | |
| End With | |
| End If | |
| End Sub | |
| |
| Übergabe eines Zellwertes aus VBA-Excel an die Zwischenablage |
| |
| "altes" Makro mit Abfrage nach Dateiname und Programmaufruf mit Shell... |
| Sub cmdWriteTag_Click() | |
| Dim DateiName$, AbLage As DataObject | |
| DateiName = "C:\WINNT\StartMP3.exe" 'Aufruf der Starter-EXE |
| If Dir(DateiName) = "" Then | |
| MsgBox "Die Datei zum Lesen / Schreiben des MP3-Tags ist nicht " & Chr(10) & _ |
| "vorhanden (StartMP3.exe)! " & Chr(10) & Chr(10) & _ |
| "Der Programmpfad muss im Quellcode angepasst werden! ", vbInformation, "Info" |
| Else | |
| On Error GoTo 100 | |
| Set AbLage = New DataObject 'Im Gegensatz zu VB gibt es bei VBA kein Clipboard-Objekt |
| If ActiveCell.Value <> "" Then | |
| AbLage.SetText ActiveCell.Value | |
| AbLage.PutInClipboard | |
| Call Shell(DateiName, 1) | |
| On Error GoTo 0 | |
| Else | |
| 100: | |
| Call Shell(DateiName, 1) | |
| End If | |
| End If | |
| End Sub | |
| |
| ... und dann bauen wir die Starter-EXE mal in VBA-Excel ein. Wir basteln uns einen Verweis... |
 | |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
 | |
| Dim AbLage As DataObject | |
| Set AbLage = New DataObject | |
| If ActiveCell.Value <> "" Then | |
| 'Zellenwert in die Zwischenablage | |
| AbLage.SetText ActiveCell.Value | |
| AbLage.PutInClipboard | |
| CallInstanz | |
| End If | |
| End Sub | |
| |
| Function CallInstanz() 'Code steht im Modul | |
| Dim Instanz As ReadWriteMP3.MP3Instanz | |
| Set Instanz = New ReadWriteMP3.MP3Instanz | |
| With New ReadWriteMP3.MP3Instanz | |
| .MP3Start Command$ | |
| End With | |
| End Function | |
| |
| - Zelle im Excel-Sheet markieren | |
| - Gewünschter Pfad erscheint immer in der ActiveX-EXE (es bleibt stets nur eine Instanz geöffnet) |
 | |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| VBA-Anwendung: | ActiveX-EXE: |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| Erkenntnisse | |
| Da im VBA keine ActiveX-Fehler abgefangen werden können ("On Error" funktioniert nicht, falls sich die ActiveX-EXE nicht in |
| ihrem Stammverzeichnis befindet) empfiehlt sich die Variante mit der Starter-EXE (dann sendet das System wenigstens |
| eine MsgBox "Automatisierungsfehler"). |
| Der Programmstart (mit Start-EXE) klappt auch über SendTo oder aus dem Startmenü; es braucht sich nur ein gültiger Dateipfad |
| in der Zwischenablage befinden! |
| Falls die ActiveX-EXE versehentlich mehrfach allein geöffnet wird, laufen dennoch mehrere Instanzen. |
| Dieser Nebeneffekt wird abgefangen mit: |
|
| Public Sub Main() |
| Dim OldTitle$ |
| If App.PrevInstance Then 'Läuft von dieser Anwendung schon eine Instanz? |
| OldTitle = App.Title 'Dann den Titel dieser aktuellen Instanz umbennen |
| App.Title = "SampleToDelete" |
| AppActivate OldTitle 'Aktuelle Instanz schließen |
| End |
| Else |
| If App.StartMode = vbSModeStandalone Then |
| Form1.Show |
| End If |
| End If |
| End Sub |
| |
zurück