home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / ReadOutput1748885222004.psc / frmReadOutputExample.frm < prev    next >
Text File  |  2004-05-22  |  7KB  |  205 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "Richtx32.ocx"
  3. Begin VB.Form frmReadOutputExample 
  4.    BackColor       =   &H00000000&
  5.    BorderStyle     =   4  'Fixed ToolWindow
  6.    Caption         =   "Endra's MS-DOS [The Lost Version]"
  7.    ClientHeight    =   3870
  8.    ClientLeft      =   45
  9.    ClientTop       =   315
  10.    ClientWidth     =   10605
  11.    Icon            =   "frmReadOutputExample.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3870
  16.    ScaleWidth      =   10605
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   3  'Windows Default
  19.    Begin VB.CommandButton cmdCancel 
  20.       Caption         =   "&Cancel"
  21.       Height          =   375
  22.       Left            =   9120
  23.       MousePointer    =   1  'Arrow
  24.       TabIndex        =   3
  25.       Top             =   120
  26.       Width           =   1335
  27.    End
  28.    Begin prjReadOutput.ReadOutput ReadOutput1 
  29.       Left            =   9240
  30.       Top             =   3000
  31.       _ExtentX        =   1720
  32.       _ExtentY        =   1296
  33.    End
  34.    Begin VB.CommandButton cmdExecute 
  35.       Caption         =   "E&xecute"
  36.       Height          =   375
  37.       Left            =   7680
  38.       MousePointer    =   1  'Arrow
  39.       TabIndex        =   1
  40.       Top             =   120
  41.       Width           =   1335
  42.    End
  43.    Begin VB.TextBox txtCommand 
  44.       BackColor       =   &H00000000&
  45.       BorderStyle     =   0  'None
  46.       BeginProperty Font 
  47.          Name            =   "MS Sans Serif"
  48.          Size            =   12
  49.          Charset         =   0
  50.          Weight          =   400
  51.          Underline       =   0   'False
  52.          Italic          =   0   'False
  53.          Strikethrough   =   0   'False
  54.       EndProperty
  55.       ForeColor       =   &H8000000B&
  56.       Height          =   405
  57.       Left            =   4200
  58.       TabIndex        =   0
  59.       Text            =   "ping www.google.com"
  60.       Top             =   120
  61.       Width           =   3375
  62.    End
  63.    Begin RichTextLib.RichTextBox rtfOutput 
  64.       Height          =   3135
  65.       Left            =   120
  66.       TabIndex        =   4
  67.       Top             =   600
  68.       Width           =   10335
  69.       _ExtentX        =   18230
  70.       _ExtentY        =   5530
  71.       _Version        =   393217
  72.       BackColor       =   0
  73.       BorderStyle     =   0
  74.       Enabled         =   -1  'True
  75.       ReadOnly        =   -1  'True
  76.       ScrollBars      =   2
  77.       TextRTF         =   $"frmReadOutputExample.frx":030A
  78.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  79.          Name            =   "MS Dialog"
  80.          Size            =   6
  81.          Charset         =   0
  82.          Weight          =   700
  83.          Underline       =   0   'False
  84.          Italic          =   0   'False
  85.          Strikethrough   =   0   'False
  86.       EndProperty
  87.    End
  88.    Begin VB.Label lblInfo 
  89.       AutoSize        =   -1  'True
  90.       BackColor       =   &H80000008&
  91.       Caption         =   "Command to get output from:"
  92.       BeginProperty Font 
  93.          Name            =   "Verdana"
  94.          Size            =   12
  95.          Charset         =   0
  96.          Weight          =   700
  97.          Underline       =   0   'False
  98.          Italic          =   0   'False
  99.          Strikethrough   =   0   'False
  100.       EndProperty
  101.       ForeColor       =   &H8000000B&
  102.       Height          =   270
  103.       Left            =   120
  104.       TabIndex        =   2
  105.       Top             =   120
  106.       Width           =   3915
  107.    End
  108. End
  109. Attribute VB_Name = "frmReadOutputExample"
  110. Attribute VB_GlobalNameSpace = False
  111. Attribute VB_Creatable = False
  112. Attribute VB_PredeclaredId = True
  113. Attribute VB_Exposed = False
  114. 'You may use this code in your project as long as you dont claim its yours ;)
  115.  
  116. 'NEW IN V2.1:
  117. '   -Nice more DOS like environment
  118. '   -Replaced TextBox with Rich Text Format Box (More then 65535 chars allowed)
  119. '   -Added support to the DOS 'CLS' command (Clear Screen)
  120. '   -Replaced output of DOS 'CD' command to be C:\
  121. '   -Made it show default path as C:\>
  122. '   -Colors changed
  123. '   -Added KeyPress event so you can press ENTER instead of clicking Execute
  124. 'Thats about it..
  125. 'NO changes have been done in the control!
  126. 'Enjoy!
  127.  
  128. Option Explicit
  129.  
  130. Private Sub cmdCancel_Click()
  131.     txtCommand.SetFocus
  132.     ReadOutput1.CancelProcess
  133. End Sub
  134.  
  135. Private Sub cmdExecute_Click()
  136.     txtCommand.SetFocus
  137.     ReadOutput1.SetCommand = txtCommand.Text
  138.     ReadOutput1.ProcessCommand
  139. End Sub
  140.  
  141. Private Sub Form_Load()
  142.     Me.Show
  143.     rtfOutput.Text = "[**] Endra's Version of MS-DOS [**]" & vbNewLine & vbNewLine & "C:\> "
  144.     txtCommand.SetFocus
  145.     rtfOutput.SelStart = 0
  146.     rtfOutput.SelLength = Len(rtfOutput.Text)
  147.     rtfOutput.SelColor = &H80000000
  148. End Sub
  149.  
  150. Private Sub ReadOutput1_Canceled()
  151.     rtfOutput.Text = rtfOutput.Text & vbNewLine & "[**] Process Canceled [**]" & vbNewLine & vbNewLine & "C:\> "
  152.     MsgBox "Success! Process was canceled!"
  153. End Sub
  154.  
  155. Private Sub ReadOutput1_Complete()
  156.     If rtfOutput.Text = "" Then
  157.         rtfOutput.Text = "C:\> "
  158.     Else
  159.         rtfOutput.Text = rtfOutput.Text & vbNewLine & "C:\> "
  160.         MsgBox "Complete reading output!", vbOKOnly, "Success!"
  161.     End If
  162. End Sub
  163.  
  164. Private Sub ReadOutput1_Error(ByVal Error As String, LastDLLError As Long)
  165.     MsgBox "Error!" & vbNewLine & _
  166.             "Description: " & Error & vbNewLine & _
  167.             "LastDLLError: " & LastDLLError, vbCritical, "Error"
  168. End Sub
  169.  
  170. Private Sub ReadOutput1_GotChunk(ByVal sChunk As String, ByVal LastChunk As Boolean)
  171.     'your probly wondering why I put LastChunk when I already put the Complete event..
  172.     'if you test you'll see that you get chunk by chunk (256 chars), not line by line
  173.     'so if you want to parse those, you'll need to know when it finishes so you can
  174.     'release your last line since you cannot check if its complete by using the event.
  175.     'LastChunk is false if there is more chunks, true if that is the last chunk.
  176.     If Len(sChunk) >= 3 Then
  177.         If Left(sChunk, Len(sChunk) - 2) = App.Path Then
  178.             rtfOutput.Text = rtfOutput.Text & "C:\" & vbNewLine
  179.             Exit Sub
  180.         End If
  181.     End If
  182.     rtfOutput.Text = rtfOutput.Text & Replace(Replace(sChunk, Chr(13), ""), Chr(10), vbNewLine)
  183.     If Len(sChunk) = 1 Then
  184.         If Asc(sChunk) = 12 Then
  185.             rtfOutput.Text = "[**] Endra's Version of MS-DOS [**]" & vbNewLine
  186.         End If
  187.     End If
  188. End Sub
  189.  
  190. Private Sub ReadOutput1_Starting()
  191.     rtfOutput.Text = rtfOutput.Text & ReadOutput1.SetCommand & vbNewLine
  192. End Sub
  193.  
  194. Private Sub txtCommand_KeyPress(KeyAscii As Integer)
  195.     If KeyAscii = vbKeyReturn Then
  196.         cmdExecute_Click
  197.         KeyAscii = 0
  198.     End If
  199. End Sub
  200.  
  201. Private Sub rtfOutput_Change()
  202.     rtfOutput.SelStart = Len(rtfOutput.Text) + 1
  203.     rtfOutput.SelLength = Len(rtfOutput.Text) + 1
  204. End Sub
  205.