Soyez le premier à donner votre avis sur cette source.
Vue 7 177 fois - Téléchargée 508 fois
Option Explicit 'Les apis 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 SetConsoleMode _ Lib "kernel32" ( _ ByVal hConsoleOutput As Long, _ dwMode As Long) _ 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 '\'API pour attendre Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) '\'Types de handle qu'on peut avoir pour la console Private Const STD_INPUT_HANDLE = -10& Private Const STD_OUTPUT_HANDLE = -11& Private Const STD_ERROR_HANDLE = -12& '\ 'Couleurs possibles pour SetConsoleTextAttribute Private Const FOREGROUND_BLUE = &H1 Private Const FOREGROUND_GREEN = &H2 Private Const FOREGROUND_RED = &H4 Private Const FOREGROUND_INTENSITY = &H8 Private Const BACKGROUND_BLUE = &H10 Private Const BACKGROUND_GREEN = &H20 Private Const BACKGROUND_RED = &H40 Private Const BACKGROUND_INTENSITY = &H80 '\ 'Options pour SetConsoleMode (input) 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 '\ 'Options pour SetConsoleMode (output) Private Const ENABLE_PROCESSED_OUTPUT = &H1 Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2 '\'Variables Globales Private hIn As Long ' Input Private hOut As Long ' Output '\ Public Sub EcrireConsole(Str As String) 'Pour écrire sans ce casser la tête WriteConsole hOut, Str, Len(Str), vbNull, vbNull End Sub Public Function LireConsole() 'Pour lire simplement Dim Str As String * 256 ReadConsole hIn, Str, Len(Str), 0, vbNullString LireConsole = Left$(Str, InStr(Str, Chr$(0)) - 1) End Function Private Sub main() On Error Resume Next Dim Buffer As String AllocConsole 'Créer la console SetConsoleTitle "Je suis un programme dans une console!!!!" 'Placer le titre 'Obtenir le handle pour LIRE et ÉCRIRE sur la console hIn = GetStdHandle(STD_INPUT_HANDLE) hOut = GetStdHandle(STD_OUTPUT_HANDLE) '\ 'Placer des options pour le texte SetConsoleTextAttribute hOut, FOREGROUND_GREEN '\ 'Comment écrire du texte ... (on peut en changer les couleurs comme on veut) (C'est l'en-tête pour présenter le programme) EcrireConsole String$(50, "*") & vbCrLf & "Lanceur de fichiers en console Version 1.0" & vbCrLf & "Par DeadlyPredator" & vbCrLf & String$(50, "*") & vbCrLf SetConsoleTextAttribute hOut, FOREGROUND_RED EcrireConsole "Inscivez Bye et appuyez sur Enter pour quitter" & vbCrLf SetConsoleTextAttribute hOut, FOREGROUND_RED + FOREGROUND_GREEN + FOREGROUND_INTENSITY EcrireConsole ">" '\ 'Traitement des données Do 'Bon, là c simple. C'est une boucle sans fin (on doit l'intérompre avec Exit Do) qui permet d'obtenir du texte écrit Do 'Attendre le Enter Buffer = LireConsole 'Il faut lire la ligne If InStr(1, Buffer, Chr(13) + Chr(10)) <> 0 Then Exit Do 'SI C'EST L'UTILISATEUR À APPUYÉ ENTER, SORTIR DE CETTE BOUCLE Sleep 500 'Pour ne pas surcharger le CPU DoEvents '... Loop '\ Buffer = Replace(Buffer, Chr(13) + Chr(10), "") 'Dans mon cas, enlever le CRLF à la fin de la ligne 'Rendu ici, vous traitez le message :) If LCase$(Buffer) = "?bye" Then Exit Do 'Bon, si c'est marqué ?bye on sort Shell Buffer If Err.Number <> 0 Then 'ERREUR AVEC LE PROGRAMME!! SetConsoleTextAttribute hOut, FOREGROUND_RED 'Rouge EcrireConsole "Erreur! Impossible d'ouvrir le fichier """ & Buffer & """" & vbCrLf 'Description SetConsoleTextAttribute hOut, FOREGROUND_RED + FOREGROUND_GREEN + FOREGROUND_INTENSITY 'On remet la couleur jaune End If '\ 'On remet le petit signe > EcrireConsole ">" '\ DoEvents Loop '\FreeConsole 'Libérer la console End Sub
Merci de réponses...
JM
W@rning
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.