| |
|
|
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 |
|
|
| |
|
|
|
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 ▲ |
|
|
|
|
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: CompileMarkSeparation {$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.
. |
|
|
| |
|
|
|
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 ▲ |
|
|
|
|
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)
. |
|
|
| |
|
|
|
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 ▲ |
|
|
|
|
Jörg Sellmeyer | I Have the program time something gelichtet. Perhaps helps it you. CompileMarkSeparation $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 ▲ |
|
|
|
|
| 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 |
|
|
| |
|
|
|
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 |
|
|
| |
|
|
|
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 ▲ |
|
|
|
|
| [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] |
|
|
| |
|
|