Envoi de chaînes sur la console

Contenu du snippet

Nix avait expliqué comment déclencher un programme DOS (Rubrique Shell : Envoyer une commande DOS). Voici la même chose, mais en beaucoup plus compliqué (et un peu plus puissant...).

Source / Exemple :


VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   975
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3585
   LinkTopic       =   "Form1"
   ScaleHeight     =   975
   ScaleWidth      =   3585
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "C'est parti !"
      Height          =   495
      Left            =   1200
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long

Private Const STD_OUTPUT_HANDLE = -11&

Private hConsole As Long

Private Sub Command1_Click()
'*** Pour lancer un application appelée Text.exe ou test.bat, par exemple
Dim app_name As String
Dim txt As String
Dim num_written As Long

    app_name = App.Path
    If Right$(app_name, 1) <> "\" Then app_name = app_name & "\"
    app_name = app_name & "test.bat"

    txt = "Alors, on y va ?" & vbCrLf
    WriteConsole hConsole, txt, Len(txt), num_written, vbNullString
    'enlever le commentaire à la suite pour lancer l'application....
    'Shell app_name
End Sub
Private Sub Form_Load()
Dim txt As String
Dim num_written As Long
    If AllocConsole() Then
        hConsole = GetStdHandle(STD_OUTPUT_HANDLE)
        If hConsole = 0 Then MsgBox "Impossible d'allouer STDOUT"

        ' Par sécurité, pour les neuneus....
        txt = "***********************************************" & vbCrLf & _
              "*   Attention, fermer l'appli VB en premier   *" & vbCrLf & _
              "***********************************************" & vbCrLf
        WriteConsole hConsole, txt, Len(txt), num_written, vbNullString

        ' Rend l'appli visible, au premier plan....
        Me.Show
        SetFocus
    Else
        MsgBox "Impossible d'allouer STDOUT"
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    CloseHandle hConsole
    FreeConsole
End Sub

Conclusion :


Créez un fichier format texte, mettez le code dedans puis renommez le fichier en Form1.frm Ouvrez form1.frm avec VB 5 ou VB 6, sous 95 ou 98 (devrait pas avoir de problème en NT)... et cliquez.
Trouvez à quoi ca sert et me prévenir....

A voir également

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.