Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen Download
Dateidownload

Fullscreen Commandline für Vista und 7

Uploader:Mitgliedascorbin
Datum/Zeit:24.12.2009 11:56:51

' FSCMD.bas - Fullscreen Commandline für Windows Vista und 7
' 24.12.2009 12:36
' Mein erster Upload.. weder ausgereift, noch weltbewegend..
'
' Dank an alle FreeBASIC-Portal Nutzer/Betreiber,
' für Quellcodes, Ideen und Lösungen!
'
' Hinweis:
' Dieser Code und das Programm was daraus erstellt werden kann darf nicht für Staatliche oder Militärische Zwecke genutzt werden!
' Noch von Angehörigen der selben Organisationen! An sonsten erhebe ich keinerlei Ansprüche auf Kopierschutzrechte oder der gleichen!
'
' Danke für Eure Aufmerksamkeit..
' mfg [aScOrBiN]
'
'
'
'fscmd.cfg:
'[FullScreenCMD]
'ScrResX=800
'ScrResY=600
'ScrBits=32
'EchoDir=1


#Inclib "kernel32.dll"
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Function RCfg(strsection As String, strkey As String, strfullpath As String) As String
   Dim strbuffer As String
   strbuffer = String(750, Chr(0))
   RCfg = Left(strbuffer, GetPrivateProfileString(strsection, ByVal LCase(strkey), "", strbuffer, Len(strbuffer), strfullpath))
End Function

Sub CmdWrap(InCommand As String)
    Dim As String PrinPut
    If LCase(InCommand) = "cls" Then Exit Sub
    If LCase(Left(InCommand,5)) = "color" Then Print "ERROR: COLOR COMMAND NOT SUPPORTET YET!":Print "":Exit sub
    Open Pipe InCommand For Input As #1
    Do
        Line Input #1, PrinPut
        Print PrinPut
    Loop Until Eof(1)
    Close #1
End Sub

Dim As Integer ResX = CInt(RCfg("FullScreenCMD","ScrResX", CurDir & "\fscmd.cfg"))
Dim As Integer ResY = CInt(RCfg("FullScreenCMD","ScrResY", CurDir & "\fscmd.cfg"))
Dim As Integer Bits = CInt(RCfg("FullScreenCMD","ScrBits", CurDir & "\fscmd.cfg"))
Dim As String ShowDir = RCfg("FullScreenCMD","EchoDir", CurDir & "\fscmd.cfg")
Dim As String TheCommand

ScreenRes ResX, ResY, Bits,, 1

CmdWrap("ver")
Do
    If ShowDir = "1" Then Print CurDir & ">";
    Input "", TheCommand

    If LCase(TheCommand) = "exit" Then End
    If LCase(Left(TheCommand,4)) = "cd.." Then ChDir("..")
    If LCase(Left(TheCommand,3)) = "cd " Then ChDir(Mid(TheCommand,4))
    If LCase(Left(TheCommand,4)) = "cd \" Then ChDir("\..")
    If LCase(Left(TheCommand,4)) = "cd /" Then ChDir("\..")
    If LCase(TheCommand) = "cls" Then Cls

    CmdWrap(TheCommand)
Loop