XProfan

English

Juergen
Overr

Hello

can someone say How I at terminate one Program (or during the Laufzeit) a Text output the CMD-Line beget, if I the program in a Dos-Box starte?

the Program should over a Batch-File launched and be to termination a String give back, the in the DOS-Box To see is, or moreover processing go can.
yet Have I this only over the detour of/ one self-contained File there get.

greeting Jürgen
XProfan10

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

You can the program not really in a Dos-Box run. its even no Dos Program - it'll always as eigener Process under windows walk.

You can with Profan a Console produce:
[...]

there walk then but against no Dos-programs. whether to the somehow contact can? Such time to "Console", Perhaps helps you there what moreover

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Juergen
Overr

You can the program not really in a Dos-Box run. its even no Dos Program - it'll always as eigener Process under windows walk

the disturbing not further, I no Window beget, falls not on.

The Search to Console Have I implemented.

thereby be I on this code bumped:
Compile Mark Separation

 {$runtime prfrun32.xp9.nores.console.exe}
 {$crq}
Declare text$,x&,y&,con&,conrect#
Dim conrect#,20
Def AllocConsole(0) !"KERNEL32","AllocConsole"
Def FreeConsole(0) !"KERNEL32","FreeConsole"
Def GetStdHandle(1) !"KERNEL32","GetStdHandle"
Def SetConsoleTitle(1) !"KERNEL32","SetConsoleTitleA"
Def SetConsoleTextAttribute(2) !"KERNEL32","SetConsoleTextAttribute"
Def WriteConsole(5) !"KERNEL32","WriteConsoleA"

Proc PrintCon

    Parameters context$
    context$=context$+Chr$(13)+chr$(10)
    WriteConsole(con&,addr(context$),len(context$),addr(x&),0)

EndProc

AllocConsole()
text$="Console Testfenster"
SetConsoleTitle(addr(text$))
con&=GetStdHandle(-11)

Whileloop 100

    PrintCon "Test "+Str$(Rnd(1000))

Wend

WaitInput
FreeConsole()
End

this code let itself though first compilieren after I The row 1 and 2 auskommentiert have (what mean these because??)

really very the I Search,.
The begot spending becomes though in a NEUEN Console created, not in the in the the program launched watts.

.

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

XPSE is a Precompiler for XProfan [...]

with the Console can I you unfortunately not help on. The Link in of my first response helps you not?

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Juergen
Overr

unfortunately No.

too in this example becomes a NEUE Console opened.
furthermore fractures the program with of/ one Error Message ex:

...Program has a Error fixes and must exits go ....

(gestestet XP-per 2002)

.

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

J.
Strahl

The spending on the Clipboard send, and the DOS Box read. though, working the so far too only with a Zusatzprogramm.

winclip [...]

so You can then the Clipboard the Console read.

Windows 7 Ultimate 64 * 12 GB Ram * XProfan 11.2a * PRFellow * PRFPAD

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

I Have the program time something gelichtet. Perhaps helps it you.
Compile Mark Separation

 $I profalt.inc
PRFellow-Vorlage
Autor: Thomas Hölzer - Alle Rechte vorbehalten
Beispiel-Programm für eine fenstergebundene Konsole
Benötigt Profan 6.1 wegen Addr-Funktion
(Umstellung auf Profan 5.0 mit Bereichsvariable ist möglich)
(c) 2000 Thomas Hölzer, Siegen - Alle Rechte vorbehalten
Def AllocConsole(0) !"KERNEL32","AllocConsole"
Def CloseHandle(1) !"KERNEL32","CloseHandle"
Def CreateConsoleScreenBuffer(5) !"KERNEL32","CreateConsoleScreenBuffer"
Def FillConsoleOutputAttribute(5) !"KERNEL32","FillConsoleOutputAttribute"
Def FlushConsoleInputBuffer(1) !"KERNEL32","FlushConsoleInputBuffer"
Def FreeConsole(0) !"KERNEL32","FreeConsole"
Def GetConsoleTitle(2) !"KERNEL32","GetConsoleTitleA"
Def GetConsoleScreenBufferInfo(2) !"KERNEL32","GetConsoleScreenBufferInfo"
Def GetStdHandle(1) !"KERNEL32","GetStdHandle"
Def ReadConsole(5) !"KERNEL32","ReadConsoleA"
Def ReadConsoleOutputCharacter(5) !"KERNEL32","ReadConsoleOutputCharacterA"
Def ReadFile(5) !"KERNEL32","ReadFile"
Def SetConsoleActiveScreenBuffer(1) !"KERNEL32","SetConsoleActiveScreenBuffer"
Def SetConsoleCursorPosition(2) !"KERNEL32","SetConsoleCursorPosition"
Def SetConsoleMode(2) !"KERNEL32","SetConsoleMode"
Def SetConsoleTextAttribute(2) !"KERNEL32","SetConsoleTextAttribute"
Def SetConsoleTitle(1) !"KERNEL32","SetConsoleTitleA"
Def WriteConsole(5) !"KERNEL32","WriteConsoleA"
Def WriteConsoleOutputCharacter(5) !"KERNEL32","WriteConsoleOutputCharacterA"
Def WriteFile(5) !"KERNEL32","WriteFile"
Def OemToCharBuff(3) !"USER32","OemToCharBuffA"
Def CharToOemBuff(3) !"USER32","CharToOemBuffA"
Def FillMemory(3) !"KERNEL32","RtlFillMemory"
Def ZeroMemory(2) !"KERNEL32","RtlZeroMemory"
Def ExitProcess(1) !"KERNEL32","ExitProcess"
Def MakeLong(2) Or(&(1),Mul(&(2),$10000))
Def HiWord(1) Div&(&(1),$10000)
Def LoWord(1) And(&(1),$FFFF)
Def GetInput(0) $(0)
Def GetCleanInput(0) Upper$(Trim$($(0)))
Def RemoveCR(1) Translate$($(1),Add$(Chr$(13),Chr$(10)),Chr$(32))
Declare hinput&,houtput&,herror&,hscrbuf&
Declare BUF_INFO#,c_buf#
Declare INPUT_REC#

Proc GetScreenBufSize

    Declare size&
    Dim BUF_INFO#,20
    GetConsoleScreenBufferInfo(hscrbuf&,BUF_INFO#)
    Let size&=Long(BUF_INFO#,0)
    Let size&=LoWord(size&) * HiWord(size&) bei WideChar * 2, aber wir nehmen ANSI
    Dispose BUF_INFO#
    Return size&

EndProc

Proc LineColor

    Parameters fg%,bg%
    Declare colattr&
    Let colattr&=Or(fg%,Mul(bg%,4))
    SetConsoleTextAttribute(hscrbuf&,colattr&)

EndProc

Proc _WriteLn

    Parameters txt$,oem_convert%,cr%
    Declare written&
    Let txt$=txt$
    Case cr%: Let txt$=txt$;Chr$(13);Chr$(10)
    Dim c_buf#,(Len(txt$) + 1)
    String c_buf#,0=txt$
    Case oem_convert%: CharToOemBuff(c_buf#,c_buf#,Len(txt$))
    WriteConsole(hscrbuf&,c_buf#,Len(txt$),Addr(written&),0)
    WriteFile(hscrbuf&,c_buf#,Len(txt$),Addr(written&),0)
    Dispose c_buf#

EndProc

Proc Write

    Parameters txt$
    _Writeln txt$,1,0

EndProc

Proc WriteCR

    _Writeln "",0,1

EndProc

Proc WriteLn

    Declare txt$,i%
    Let i%=1

    WhileNot Gt(i%,%pcount)

        Let txt$=Add$(txt$,$(i%))
        Inc i%

    Wend

    _Writeln txt$,1,1

EndProc

Proc WriteCGI

    Parameters txt$
    _Writeln txt,0,0

EndProc

Proc WriteLnCGI

    Declare txt$,i%
    Let i%=1

    WhileNot Gt(i%,%pcount)

        Let txt$=Add$(txt$,$(i%))
        Inc i%

    Wend

    _WriteLn txt$,0,1

EndProc

Proc ReadLn

    Declare read&,txt$
    Dim c_buf#,261
    ZeroMemory(c_buf#,261)
    ReadConsole(hinput&,c_buf#,261,Addr(read&),0)
    Let txt$=RemoveCR(String$(c_buf#,0))
    Dispose c_buf#
    Return txt$

EndProc

Proc ReadOutput

    muß noch auf zeilenweises Auslesen umgestellt werden wg. CR
    Declare txt$,read&,size&
    GetScreenBufSize
    Let size&=&(0)
    Dim c_buf#,size&
    ZeroMemory(c_buf#,size&)
    ReadConsoleOutputCharacter(hscrbuf&,c_buf#,size&,0,Addr(read&))
    OemToCharBuff(c_buf#,c_buf#,read&)
    Let txt$=String$(c_buf#,0)
    Dispose c_buf#
    Let txt$=Translate$(txt$, "  ","")
    Return Trim$(txt$)
    Return txt$

EndProc

Proc SetConsoleCaption

    Parameters txt$
    Dim c_buf#,Add(Len(txt$),1)
    String c_buf#,0=txt$
    SetConsoleTitle(c_buf#)
    Dispose c_buf#

EndProc

Proc GotoXY

    Parameters x%,y%
     $D "",x%,y%,hscrbuf&
    SetConsoleCursorPosition(hscrbuf&,MakeLong(x%,y%))

EndProc

Proc ClearConsole

    Parameters color&
    Declare written&,size&
     $B "2"
    GetScreenBufSize
    Let size&=&(0)
    Case (color& < 7): color&=7
    FlushConsoleInputBuffer(hscrbuf&)
    SetConsoleTextAttribute(hscrbuf&,color&)
    Dim c_buf#,size&
     $B "3"
    FillMemory(c_buf#,size&,32)
    WriteConsoleOutputCharacter(hscrbuf&,c_buf#,size&,0,Addr(written&))
    FillConsoleOutputAttribute(hscrbuf&,color&,size&,0,Addr(written&))
    Dispose c_buf#
    traceon
    GotoXY 0,0
    traceoff

EndProc

Proc _CreateCon

    Parameters title$,own_win%
    Case own_win%: AllocConsole()
    SetConsoleCaption title$
    Let hinput&=GetStdHandle(-10)
    Let houtput&=GetStdHandle(-11)
    Let herror&=GetStdHandle(-12)
    Let hscrbuf&=houtput&
    SetConsoleMode(hscrbuf&,6)

EndProc

Proc CreateConsoleInWindow

    Parameters txt$
    _CreateCon txt$,1

EndProc

Proc CreateConsole

    Parameters txt$
    _CreateCon txt$,0

EndProc

Beispiel mit Mini-Befehls-Interpreter

Proc Beispiel_Ausgabe_Im_Fenster

    Declare c_exit%,txt$

    Proc Info

        WriteLn "(c) 2000 Thomas Hölzer, Siegen, Alle Rechte vorbehalten"

    EndProc

    Proc ShowHelp

        ClearConsole 31
        Info
        WriteLn ""
        WriteLn "exit oder CTRL-C : Beenden"
        WriteLn "?                : Hilfe"
        WriteLn "cls              : Bildschirm löschen"
        WriteLn "about            : Info"
        WriteLn ""

    EndProc

    CreateConsoleInWindow "32 Bit Profan²-Konsolen-Fenster - Powered by PRFellow 2001"
    CreateConsole "32 Bit Profan²-Konsole - Powered by PRFellow 2001"
    ClearConsole 31 weiß auf blau
    WriteLn "Geben Sie ? für Hilfe ein und drücken Sie ENTER"

    WhileNot c_exit%

        txt$=Trim$(ReadLn())
        txt$=GetCleanInput()

        If Equ$(txt$,"")

        ElseIf (txt$ = "ABOUT")

            Info

        ElseIf (txt$ = "EXIT")

            Inc c_exit%

        ElseIf Equ$(txt$,"?")

            ShowHelp

        ElseIf Equ$(txt$,"CLS")

            ClearConsole 31

        Else

            WriteLn Add$("Unbekannter Befehl: ",GetInput())

        EndIf

    Wend

    FreeCo

/a>() ExitProcess(0) ENDPROC

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

08/18/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

the "Problem" is here other - because The Runtime carry not the Consolebit. I can through patchen the Exe the Consolebit settle and again such Runtimes to that Download* offer - so becomes then too the "vorhandene" Konsolenfenster of allocconsole alloziiert and used. I had imho for X9 such Runtimes time to that loading in the Downloadcenter offered.

*this time but as a precaution only for diejenigen downloadable, also by Kompilernachweis (see Verification in the Profil) shown having, that they too entsprechendes XProfan own

08/19/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Juergen
Overr

the would me very moreover help. The detour over a temp-File is still on duration something umständlich.

(btw: The letter to that verifizieren is on the way)

@Jörg
I Have time attempts a EXE from the Listing To make, me missing moreover but the profalt.inc

Greeting Jürgen
XProfan10

08/19/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

I Have time attempts a EXE from the Listing To make, me missing moreover but the profalt.inc

The will need you with XProfan10 too none. simply comment. yet sinnvoller:
any rake- and Vergleichsfunktionen in Operators umändern, z. B. x% = Add(y%,4) becomes x% = y% + 4
with XProfan11 there The functions then namely not any more.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

08/19/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

[offtopic]
@Jürgen: Verifi: Please verzeih that I to the 22. none Rückbrief Generate can there I do not in the land be - is then but naturally joining of me nachgeholt.
[/offtopic]

08/19/08 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote