title image


Smiley Ausgaben im gleichen DOS-Fenster, aus dem das Prog gestartet wurde
Hi,



ich hab's gefunden. Ich hab' auch gleich noch ein bischen Text dazugeschrieben, damit

dieser Beitrag im Archiv auch verständlich ist. Der sollte eigentlich schon ins Archiv

kommen, weil diese Frage hier öfters vorkommt und fast immer unbeantwortet bleibt.

Und wenn man nur einen Link auf den Archivbeitrag posten braucht, ist das wesentlich

einfacher, wie wenn man jedesmal diesen Beitrag schreiben muß.



Gruß

Gaga





_________________________________________________________________________



Da VB nur sog. GUI-exe'n macht, hat man ein größeres Problem, wenn man bei einem Programm

die Ausgaben das gleiche DOS-Fenster schreiben will, aus dem das Programm gestartet wurde.



Ausgaben in ein DOS-Fenster können bis VB6 (.net weiß ich nicht) nur über API-Aufrufe

gelöst werden. Diese API's brauchen aber ein eigenes DOS-Fenster bzw man kommt von VB

aus nicht auf das DOS-Fenster, von dem aus man das Prog aufgerufen hat.

Oder die API's funktionieren schlichtweg bei einer GUI-exe nicht.



Für solche Fälle braucht man eine sog. Console-exe. Irgendwo im Internet habe ich mal

ein in VB geschriebenes Programm gefunden, das aus einer GUI-exe eine Console-exe macht

(den Link weiß ich nicht mehr, ich hoffe, der Programmierer ist mir deshalb nicht böse,

aber da er es ja im Internet freigegeben hat...).





Hier ist nun das Konvertierungsprogramm. Dieser Code stammt nicht von mir, ist aber von mir

benutzt worden. Das funktioniert.



In einem neuen VB-Projekt ein bas-Modul aufnehmen, bei Projekteigenschaften als Startobjekt

Sub Main eintragen und die standardmäßig angelegte Form löschen (oder zuerst den Code

einfügen, damit man auch die Auswahl von Sub Main als Startobjekt hat).

Folgender Code muß dann ins bas-Module kopiert werden, dann das Projekt speichern und eine

exe erstellen. Die exe nenne ich jetzt mal Convert.exe.





' ------------------------------------------------------

' MakeConsole.BAS -- Copyright (c) Slightly Tilted Software

' By: L.J. Johnson       Date: 11-30-1997

' Comments:    Contains MAIN(), plus the function

'              which take a standard VB 5.0 EXE

'              and change it to a 32-bit console app

' ------------------------------------------------------

Option Explicit

Option Base 1

DefLng A-Z



Private Const GENERIC_READ                As Long = &H80000000

Private Const OPEN_EXISTING               As Long = 3&

Private Const FILE_ATTRIBUTE_NORMAL       As Long = &H80&



Private Const SCS_32BIT_BINARY = 0&

Private Const SCS_DOS_BINARY = 1&

Private Const SCS_WOW_BINARY = 2&

Private Const SCS_PIF_BINARY = 3&

Private Const SCS_POSIX_BINARY = 4&

Private Const SCS_OS216_BINARY = 5&



Private Const constMsgTitle = "Make Console App"



' ---------------------------------------------

' Windows API calls

' ---------------------------------------------

Public Declare Sub CopyMem _

   Lib "kernel32" Alias "RtlMoveMemory" _

   (dst As Any, src As Any, ByVal Size As Long)

Private Declare Function CloseHandle _

   Lib "kernel32" _

   (ByVal hObject As Long) As Long

Private Declare Function CreateFile _

   Lib "kernel32" Alias "CreateFileA" _

   (ByVal lpFileName As String, _

    ByVal dwDesiredAccess As Long, _

    ByVal dwShareMode As Long, _

    ByVal lpSecurityAttributes As Long, _

    ByVal dwCreationDisposition As Long, _

    ByVal dwFlagsAndAttributes As Long, _

    ByVal hTemplateFile As Long) As Long



Public Sub Main()

   Dim strCmd              As String

   Dim strMsg              As String

   Dim strRtn              As String

   

   strCmd = Command$

   

   If Trim$(strCmd) = "" Then

      strMsg = "You must enter the name of a VB 5.0 standard executable file."

      MsgBox strMsg, vbExclamation, constMsgTitle

   Else

      If InStr(1, strCmd, ".", vbTextCompare) = 0 Then

         strCmd = strCmd & ".EXE"

      End If

      

      If Exists(strCmd) = True Then

         strRtn = SetConsoleApp(strCmd)

         MsgBox strRtn, vbInformation, constMsgTitle

      Else

         strMsg = "The file, " & Trim$(strCmd) & ", does not exist."

         MsgBox strMsg, vbCritical, constMsgTitle

      End If

   End If

   

End Sub



Private Function SetConsoleApp(xstrFileName As String) As String

   Dim lngFileNum          As Long

   Dim ststrMZ_Header      As String * 512

   Dim strMagic            As String * 2

   Dim strMagicPE          As String * 2

   Dim lngNewPE_Offset     As Long

   Dim lngData             As Long

   Dim strTmp              As String

   Const PE_FLAG_OFFSET    As Long = 93&

   Const DOS_FILE_OFFSET   As Long = 25&

   

   ' ---------------------------------------------

   ' See if file actually exists

   ' ---------------------------------------------

   strTmp = Trim$(Dir$(xstrFileName))

   If Len(strTmp) = 0 Then

      SetConsoleApp = "Failed -- The file, " & xstrFileName & ", does not exist!"

      GoTo ExitCheck

   End If

       

   ' ---------------------------------------------

   ' Get a free file handle

   ' ---------------------------------------------

   On Error Resume Next

   lngFileNum = FreeFile

   Open xstrFileName For Binary Access Read Write Shared As lngFileNum

   

   ' ---------------------------------------------

   ' Get the first 512 characters from from file

   ' ---------------------------------------------

   Seek #lngFileNum, 1

   Get lngFileNum, , ststrMZ_Header

   

   ' ---------------------------------------------

   ' Look for the "magic header" values "MZ"

   ' If it doesn't exist, then it's not an EXE file

   ' ---------------------------------------------

   If Mid$(ststrMZ_Header, 1, 2) <> "MZ" Then

      SetConsoleApp = "Failed -- File is not an executable file."

      GoTo ExitCheck

   End If

   

   ' ---------------------------------------------

   ' Check to see if it's a MS-DOS executable

   ' ---------------------------------------------

   CopyMem lngData, ByVal Mid$(ststrMZ_Header, DOS_FILE_OFFSET, 2), 2

   If lngData < 64 Then

      SetConsoleApp = "Failed -- File is 16-bit MSDOS EXE file."

      GoTo ExitCheck

   End If

   

   ' ---------------------------------------------

   ' Get the offset for the new .EXE header

   ' ---------------------------------------------

   CopyMem lngNewPE_Offset, ByVal Mid$(ststrMZ_Header, 61, 4), 4

   

   ' ---------------------------------------------

   ' Get the "magic" header (NE, LE, PE)

   ' ---------------------------------------------

   strMagic = Mid$(ststrMZ_Header, lngNewPE_Offset + 1, 2)

   strMagicPE = Mid$(ststrMZ_Header, lngNewPE_Offset + 3, 2)

   

   Select Case strMagic

      

      ' ---------------------------------------------

      ' Check for NT format

      ' ---------------------------------------------

      Case "PE"

         If strMagicPE <> vbNullChar & vbNullChar Then

            SetConsoleApp = "Failed -- File is unknown 32-bit NT executable file."

            GoTo ExitCheck

         End If

         

         ' ---------------------------------------------

         ' Get the subsystem flags to identify NT

         '     character-mode

         ' ---------------------------------------------

         lngData = Asc(Mid$(ststrMZ_Header, lngNewPE_Offset + PE_FLAG_OFFSET, 1))

         If lngData <> 3 Then

            On Error Resume Next

            Err.Number = 0

            Seek #lngFileNum, lngNewPE_Offset + PE_FLAG_OFFSET

            Put lngFileNum, , 3

            If Err.Number = 0 Then

               SetConsoleApp = "Success -- Converted file to console app."

            Else

               SetConsoleApp = "Failed -- Error converting to console app: " & Err.Description

            End If

         Else

            SetConsoleApp = "Failed -- Already a console app"

         End If

         

      Case Else

         SetConsoleApp = "Failed -- Not correct file type."

         

   End Select



ExitCheck:

   ' ---------------------------------------------

   ' Close the file

   ' ---------------------------------------------

   Close lngFileNum

   

   On Error GoTo 0

   

End Function



Public Function Exists(ByVal xstrFullName As String) As Boolean

On Error Resume Next       ' Don't accept errors here

   Const constProcName     As String = "Exists"

   Dim lngFileHwnd         As Long

   Dim lngRtn              As Long



   ' ------------------------------------------

   ' Open the file only if it already exists

   ' ------------------------------------------

   lngFileHwnd = CreateFile(xstrFullName, _

                            GENERIC_READ, 0&, _

                            0&, OPEN_EXISTING, _

                            FILE_ATTRIBUTE_NORMAL, 0&)

   

   ' ------------------------------------------

   ' If get these specific errors, then

   '     file doesn't exist

   ' ------------------------------------------

   If lngFileHwnd = 0 Or lngFileHwnd = -1 Then

      Exists = False

   Else

      ' Success -- Must close the handle

      lngRtn = CloseHandle(lngFileHwnd)

      Exists = True

   End If



On Error GoTo 0

End Function

 





Man muß diesen Code jetzt nicht kapieren, es werden einfach ein paar Bytes in der kompilierten

exe ausgetauscht und schon hat sich's. Hut ab vor dem, der das geschrieben hat, erstens muß

man wissen, daß man "nur" ein paar Bytes austauschen muß und zweitens muß man wissen, welche

Bytes das sind und drittens muß man wissen, was man da hinschreiben muß.





So, und jetzt zum Testprogramm. Das ist von mir selbst und macht eigentlich nicht viel.

Wenn es eine GUI-exe ist, dann wird einfach eine Form angezeigt, wenn es eine Console-exe

ist, wird ins DOS-Fenster der Text "console" geschrieben.



Wir brauchen wieder ein bas-Modul und als Startobjekt Sub Main (sonst kann eine Console-exe

nie funktionieren!)



In der Form ist überhaupt kein Code (die wird ja nur angezeigt), bei einem richtigen Programm

kann das natürlich anders sein.



Und im bas-Modul ist der folgende Code. Und wieder einfach speichern und eine exe erstellen.





Option Explicit



Private Const STD_INPUT_HANDLE = -10&

Private Const STD_OUTPUT_HANDLE = -11&

Private Const STD_ERROR_HANDLE = -12&



Private Declare Function GetStdHandle Lib "kernel32" _

                        (ByVal nStdHandle As Long) As Long





Private Declare Function GetConsoleTitle Lib "kernel32" Alias "GetConsoleTitleA" _

                        (ByVal lpConsoleTitle As String, _

                         ByVal nSize As Long) As Long



Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" _

                        (ByVal hConsoleOutput As Long, _

                         ByVal lpBuffer As String, _

                         ByVal nNumberOfCharsToWrite As Long, _

                         lpNumberOfCharsWritten As Long, _

                         lpReserved As Any) As Long







Private mfrmform As Form1





Public Sub Main()

Dim booGUI As Boolean

Dim strText As String

Dim hdlConsoleOutput As Long

Dim lonnumber As Long





    strText = Space$(255)

    hdlConsoleOutput = GetStdHandle(STD_OUTPUT_HANDLE)

    If 0 <> hdlConsoleOutput Then

        If 0 = GetConsoleTitle(strText, Len(strText)) Then

            booGUI = True

        Else

            booGUI = False

        End If

    Else

        booGUI = True

    End If



    If booGUI Then

        Set mfrmform = New Form1

        mfrmform.Caption = "GUI"

        mfrmform.Show vbModal

        Set mfrmform = Nothing

    Else

        strText = "console"

        Call WriteConsole(hdlConsoleOutput, strText, Len(strText), lonnumber, 0&)

    End If

    

End Sub

 









Und jetzt kommt das entscheidende: VB hat eine GUI-exe erstellt, wir brauchen aber eine

Console-exe. Also machen wir uns eine.

Am besten Kopieren wir die von VB erstellte exe und nennen sie zB Cons.exe und die von

VB erstellte nennen wir Gui.exe.

Bis jetzt sind ja beides noch GUI-exe'n, aber aus der einen machen wir jetzt eine Console-exe.



Jetzt wird eine DOS-Box geöffnet und in das Verzeichnis zur vorher erstellten Convert.exe

gewechselt.

Jetzt wird die Convert.exe aufgerufen und als Parameter die zu konvertierende exe angegeben.

Wenn die Convert.exe und die beiden exe'n des Testprogramms im gleichen Verzeichnis sind,

dann sieht der Aufruf zB: so aus:

C:\VB_Progs\Console>Convert.exe Cons.exe

(Ansonsten muß man eben die Pfade anpassen.)

Normalerweise kommt dann eine Meldung in der Art: Konvertierung wurde erfolgreich durchgeführt.



So, und jetzt kann man testen, was passiert, wenn man von der DOS-Box aus

die GUI.exe ausführt und die Cons.exe ausführt.



Bei der GUI-exe wird die Form geöffnet, bei der Cons.exe wird der Text ins gleiche! DOS-Fenster

geschrieben.



Selbstverständlich kann man auch von einer Console-exe aus Forms öffnen.

Das Testprogramm sollte eigentlich für einen VB-Programmierer, der sich mit diesem Thema

beschäftigt, keine großen Geheimnisse verbergen.

Das problematischste an dieser Sache ist das, daß man die Ausgaben nicht debuggen kann.

Hier kann man sich so helfen, daß man überprüft, ob es eine GUI- oder Console-exe ist (beim

Progstart eine globale Variable setzen und dann diese Variable abfragen)

und im GUI-Fall die Ausgaben mit Debug.Print machen (dann sieht man sie in der Entwicklungumgebung

im Direktfenster) und im Console-Fall eben mit WriteConsole.

_________________________________________________________________________



So, das war jetzt das wesentliche, mit dem Rest kommst ja wahrscheinlich alleine klar












Gruß
Gaga

___________________________________________________________________

Profilösungen für VB6
wenn nicht anders angegeben, sind alle Codebeispiele nicht getestet, nur getippt


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: