cmd prompt funktionalitet i mit program

Ja nu skriver du godt nok "feks dir c:\" kunne du ikke bare skrive hvad det er du vil?

Så kunne det jo være vi kunne finde en bedre løsning.. som feks.


' Den gør ca. det samme som "dir c:\"
Private Sub Form_Load()
Dim strPath As String
Dim strName As String
  strPath = "C:\"
  strName = Dir(strPath, vbDirectory Or vbHidden Or vbSystem)
  Do While strName <> ""
    Debug.Print strPath & strName
    strName = Dir
  Loop
End Sub

det jeg gerne vil er at kunne bruge hvilken som helst "dos" kommando
feks en online a la del *.txt && echo "hej" > hej.txt && echo "med dig" >> hej.txt

oneliner endda

' ------------------------------------ Form1 ------------------------------------
Option Explicit

Private Sub Command1_Click()
  ' Windows 95/98/ME = command
  ' Text1.Text = ExecuteCmd("command /c echo hej")

  ' Win NT/2000/XP = cmd
  ' Text1.Text = ExecuteCmd("cmd /c echo hej")

  ' Hvis du bare skal en exe/com-file skal du ikke bruge (command / cmd)
  ' fx. netstat
  Text1.Text = ExecuteCmd("netstat -a -n")
End Sub
' ------------------------------------ Form1 ------------------------------------


' ----------------------------------- Module1 -----------------------------------
Option Explicit

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As Any, lpProcessInformation As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Type SECURITY_ATTRIBUTES
        nLength              As Long
        lpSecurityDescriptor As Long
        bInheritHandle      As Long
End Type

Private Type STARTUPINFO
        cb              As Long
        lpReserved      As Long
        lpDesktop      As Long
        lpTitle        As Long
        dwX            As Long
        dwY            As Long
        dwXSize        As Long
        dwYSize        As Long
        dwXCountChars  As Long
        dwYCountChars  As Long
        dwFillAttribute As Long
        dwFlags        As Long
        wShowWindow    As Integer
        cbReserved2    As Integer
        lpReserved2    As Long
        hStdInput      As Long
        hStdOutput      As Long
        hStdError      As Long
End Type

Private Type PROCESS_INFORMATION
        hProcess    As Long
        hThread    As Long
        dwProcessID As Long
        dwThreadID  As Long
End Type

Private Const SW_HIDE              As Long = 0
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const STARTF_USESTDHANDLES  As Long = &H100&
Private Const STARTF_USESHOWWINDOW  As Long = &H1

Public Function ExecuteCmd(ByVal strCommandline As String, Optional ByVal TimeOut As Long = 2000) As String
Dim SI As STARTUPINFO
Dim SA As SECURITY_ATTRIBUTES
Dim PI As PROCESS_INFORMATION

Dim Result As Long
Dim Success As Long

Dim hReadPipe As Long
Dim hWritePipe As Long
Dim lPeekData As Long
Dim lngTimeOut As Long

Dim Length As Long
Dim Buffer As String
Dim strOut As String

  With SA
      .nLength = Len(SA)
      .bInheritHandle = 1&
      .lpSecurityDescriptor = 0&
  End With

  Result = CreatePipe(hReadPipe, hWritePipe, SA, 0)
 
  If Result = 0 Then
    ExecuteCmd = "" 'CreatePipe failed Error!
    Exit Function
  End If

  With SI
      .cb = Len(SI)
      .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
      .wShowWindow = SW_HIDE
      .hStdOutput = hWritePipe
  End With

  Result = CreateProcessA(0&, strCommandline, SA, SA, 1&, _
                          NORMAL_PRIORITY_CLASS, 0&, _
                          0&, SI, PI)

  lngTimeOut = (GetTickCount + TimeOut)

  Do
    Call PeekNamedPipe(hReadPipe, ByVal 0&, 0&, ByVal 0&, lPeekData, ByVal 0&)
    If lPeekData > 0 Then
      Buffer = Space$(lPeekData)
      Success = ReadFile(hReadPipe, Buffer, Len(Buffer), Length, 0&)
      If Success = 1 Then
        strOut = (strOut & Left(Buffer, Length))
          Else
        strOut = "" 'ReadFile failed!
      End If
        Else
      Success = WaitForSingleObject(PI.hProcess, 0&)
      If Success = 0 Or GetTickCount >= lngTimeOut Then
        Exit Do
      End If
    End If
  Loop

  Call CloseHandle(PI.hProcess)
  Call CloseHandle(PI.hThread)
  Call CloseHandle(hReadPipe)
  Call CloseHandle(hWritePipe)

  ExecuteCmd = strOut
End Function
' ----------------------------------- Module1 -----------------------------------

og endnu engang brillierer du!!
det er bare fantastisk tak ska du ha :D

selv tak ;)