Kako u VB6 napisati nesto na konzoli

[ oggie @ 27.01.2009. 11:03 ] @

Verujem da je ovo nesto banalno, ali se ne snalazim. Dakle potreban mi je mali exe program koji ce na konzoli napisati "Hello world", znaci da otvori command prompt i ispise ovaj tekst.
Hvala unapred.

[ stefanpn @ 27.01.2009. 12:33 ] @

VB je predvidjen samo za pravljenje Windows aplikacija sa vizuelnim interfejsom uz pomoć vizuelnog interfejsa (otuda ono "Visual" u nazivu), nema ugrađenu biblioteku za rad sa konzolom, ali to možeš raditi koristeći API pozive iz biblioteke "kernel32.dll".

Sledeći primer prekopiraj u modul i postavi da ti je startup object > "Sub Main".

Code:

Option Explicit
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_ERROR_HANDLE = -12&
Private Const FOREGROUND_RED = &H4
Private Const FOREGROUND_GREEN = &H2
Private Const FOREGROUND_BLUE = &H1
Private Const FOREGROUND_INTENSITY = &H8
Private Const BACKGROUND_RED = &H40
Private Const BACKGROUND_GREEN = &H20
Private Const BACKGROUND_BLUE = &H10
Private Const BACKGROUND_INTENSITY = &H80
Private Const ENABLE_LINE_INPUT = &H2
Private Const ENABLE_ECHO_INPUT = &H4
Private Const ENABLE_MOUSE_INPUT = &H10
Private Const ENABLE_PROCESSED_INPUT = &H1
Private Const ENABLE_WINDOW_INPUT = &H8
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
Private hCmdIn As Long
Private hCmdOut As Long
Private hCmdError As Long
Sub Main()
    Dim CmdIn As String * 256
    Dim CmdOUT As String

    AllocConsole

    SetConsoleTitle "Moja konzola"

    hCmdIn = GetStdHandle(STD_INPUT_HANDLE)
    hCmdOut = GetStdHandle(STD_OUTPUT_HANDLE)
    hCmdError = GetStdHandle(STD_ERROR_HANDLE)

    SetConsoleTextAttribute hCmdOut, FOREGROUND_GREEN Or FOREGROUND_INTENSITY

    CmdOUT = "Primer" & vbCrLf

    WriteConsole hCmdOut, CmdOUT, Len(CmdOUT), vbNull, vbNull

    CmdOUT = "Unesi neki tekst: "

    WriteConsole hCmdOut, CmdOUT, Len(CmdOUT), vbNull, vbNull

    Call ReadConsole(hCmdIn, CmdIn, Len(CmdIn), vbNull, vbNull)

    CmdOUT = "Uneo si: " & Left$(CmdIn, InStr(CmdIn, Chr$(0)) - 3) & vbCrLf

    WriteConsole hCmdOut, CmdOUT, Len(CmdOUT), vbNull, vbNull

    Call ReadConsole(hCmdIn, CmdIn, Len(CmdIn), vbNull, vbNull)

    FreeConsole

End Sub

[ oggie @ 27.01.2009. 12:37 ] @

Hvala puno, ali jos uvek ne mogu da postignem ono sto hocu.
Treba mi VB exe program koji kad se pokrene sa command prompta ispise nesto npr "Hello world", a onda mi je potrebno da taj string koji je ispisao na konzoli smestim u neki fajl.
Pokusao sam ovako da redirektujem u neki fajl ali nece da radi, fajl mi je prazan.

Shell "command.com /c" + App.Path + "\NekiProgram.exe > outfile.txt"

[ stefanpn @ 27.01.2009. 12:57 ] @

Nisam siguran da te bas najbolje razumem, ali probaj ovako:

Code:

Option Explicit
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_ERROR_HANDLE = -12&
Private Const FOREGROUND_RED = &H4
Private Const FOREGROUND_GREEN = &H2
Private Const FOREGROUND_BLUE = &H1
Private Const FOREGROUND_INTENSITY = &H8
Private Const BACKGROUND_RED = &H40
Private Const BACKGROUND_GREEN = &H20
Private Const BACKGROUND_BLUE = &H10
Private Const BACKGROUND_INTENSITY = &H80
Private Const ENABLE_LINE_INPUT = &H2
Private Const ENABLE_ECHO_INPUT = &H4
Private Const ENABLE_MOUSE_INPUT = &H10
Private Const ENABLE_PROCESSED_INPUT = &H1
Private Const ENABLE_WINDOW_INPUT = &H8
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
Private hCmdIn As Long
Private hCmdOut As Long
Private hCmdError As Long

Public Buffer As String

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Main()

    Dim ff As Integer
    ff = FreeFile()

    AllocConsole
    SetConsoleTitle "Moja konzola"
    hCmdIn = GetStdHandle(STD_INPUT_HANDLE)
    hCmdOut = GetStdHandle(STD_OUTPUT_HANDLE)
    hCmdError = GetStdHandle(STD_ERROR_HANDLE)

    SetConsoleTextAttribute hCmdOut, FOREGROUND_GREEN Or FOREGROUND_INTENSITY

    CPrint "Hello World!" & vbCrLf

    If Command$ = "" Then

        CPrint "Niste upisali naziv izlazne datoteke!"
        GoTo izlaz

    End If

    On Error GoTo greska

        Open Command$ For Output As #ff

            Print #ff, Buffer

        Close #ff

    GoTo izlaz

greska:

    CPrint "Greska pri upisivanju u datoteku " & Err.Description & vbCrLf

izlaz:

    Sleep 5000
    FreeConsole

End Sub

Public Sub CPrint(ByVal CmdOUT As String)

    WriteConsole hCmdOut, CmdOUT, Len(CmdOUT), vbNull, vbNull

    Buffer = Buffer + CmdOUT

End Sub

[ oggie @ 27.01.2009. 13:07 ] @

Uf, problem je mozda slozeniji nego sto sam mislio.
Kada radis u command promptu postoji redirekcija u fajl.
Ako napises u Comand promptu

dir

onda ce na ekranu izlistati direktorijume

ali ako kazes dir > nekifajl.txt on na ekranu nece nista prikazati vec ce direktorijume upisati u taj fajl.

E sad, ja u VB radim neki slozeniji program i moram preko Shell da pozovem neki exe program koji vrsi neku komunikaciju sa nekim uredjajem. Kada se pozove taj exe, onda on na ekranu Command prompta ispise nesto i ja moram da uhvatim to sto je ispisao i da proverim da li je sve uradio kako treba.
Da bih to testirao probao sam da napravim mali exe fajl koji ce da ispisuje "Hello world" ali ne na ekranu konzole nego u neki fajl, a ja cu onda u VB-u da otvorim taj fajl i da proverim da li zaista pise "Hello world".

[ stefanpn @ 27.01.2009. 13:31 ] @

Jednostavnije bi ti bilo da sam napišeš deo programa za kom. sa tim uređajem ili da potražiš neke dinamičke biblioteke po internetu koje služe za to.

Trebao si odmah da kazes sta ti treba. :)

Resenje ti je "Pipe" između tvog programa i tog programa za komunikaciju.

Evo ti primer za to:

Otvori novi projekt, dodaj formu, na formu stavi: CommandButton - Command1; TextBox - Text1.

U formu stavi sledeće redove:

Code:

Option Explicit
Private Sub Command1_Click()

    Redirect "nazivprograma.exe argumenti", Me.Text1 ' <------ Prepravi prvi argument u odgovarajuci

End Sub

Private Sub Form_Load()

    Text1.MultiLine = True

End Sub

I dodaj Modul, pa u njega stavi sl. kod:

Code:

Option Explicit
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessId As Long
  dwThreadId As Long
End Type

Private Type STARTUPINFO
  cb As Long
  lpReserved As Long
  lpDesktop As Long
  lpTitle As Long
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Byte
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type

Private Type OVERLAPPED
    ternal As Long
    ternalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type

Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0
Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2

Sub Redirect(cmdLine As String, objTarget As Object)

    Dim i As Long
    Dim t As String
    Dim pa As SECURITY_ATTRIBUTES
    Dim pra As SECURITY_ATTRIBUTES
    Dim tra As SECURITY_ATTRIBUTES
    Dim pi As PROCESS_INFORMATION
    Dim sui As STARTUPINFO
    Dim hRead As Long
    Dim hWrite As Long
    Dim bRead As Long
    Dim lpBuffer(1024) As Byte
    pa.nLength = Len(pa)
    pa.lpSecurityDescriptor = 0
    pa.bInheritHandle = True

    pra.nLength = Len(pra)
    tra.nLength = Len(tra)

    If CreatePipe(hRead, hWrite, pa, 0) <> 0 Then
        sui.cb = Len(sui)
        GetStartupInfo sui
        sui.hStdOutput = hWrite
        sui.hStdError = hWrite
        sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        sui.wShowWindow = SW_HIDE
        If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then
            SetWindowText objTarget.hwnd, ""
            Do
                Erase lpBuffer()
                If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then
                    SendMessage objTarget.hwnd, EM_SETSEL, -1, 0
                    SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0)
                    DoEvents
                Else
                    CloseHandle pi.hThread
                    CloseHandle pi.hProcess
                    Exit Do
                End If
                CloseHandle hWrite
            Loop
            CloseHandle hRead
        End If
    End If

End Sub

[ oggie @ 27.01.2009. 13:40 ] @

Hvala ti.... al se ovo zakomplikovalo.
Taj program za komunikaciju nema veze sa mnom, dobijam ga eksterno i ne mogu nista da menjam. Znam samo da treba da ga pokrenem i da iscitam sta ispise na ekranu i od zavisnosti od toga ja radim neke dalje korake.

Probacu ovu tvoju verziju, ali ne mogu sad jer mi taj exe jos nije stigao (zato sam trazio onaj "Hello" za test).

Samo mi nije jasno zasto iz VB-a nece da radi ovo:

Shell "command.com /c + dir>proba.txt"

[ stefanpn @ 27.01.2009. 13:46 ] @

Radi.

Ali VBA.Interaction.Shell ne prosleđuje argumente pri pokretanju programa, pa se to radi sa ShellExecute metodom iz "shell32.dll".

Code:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Form_Load()

ShellExecute Me.hwnd, vbNullString, "command.com", " /c + dir >proba.txt", "C:\", SW_SHOWNORMAL

End Sub

[ oggie @ 27.01.2009. 14:08 ] @

E sad i meni radi. Hvala puno, puno....

[ dava @ 28.01.2009. 08:50 ] @

Radi i ovo ...

Code:
Shell "command.com /c + dir>proba.txt"

... samo nisi naveo putanju proba.txt fajla pa u tom slucaju ga kreira tamo gdje se izvrsava program koji ga poziva, a ako ga pozivas iz IDE VB-a onda je to putanja c:\Program Files\Microsoft Visual Studio\VB98\

[ Fenix @ 15.09.2011. 23:23 ] @

a kako da se toj konzoli (procesu) dalje šalju druge komande i prati ispis poslije njih a da ovaj CreateProcess ne pokreće novu instancu već da se to dešava u staroj