i = Shell("cmd cd.. " & TempPath & EXEVer & " " & KTPComLine & " " & XMLComLine & " " & LOGComLine, vbNormalFocus)

请帮忙把这段代码更改前段成
1.开启一个DOS视窗后往上移一层目录
2.在同一DOS视窗中输入后面的命令执行动作
3.执行完毕后关闭该DOS的视窗

这有办法一行完成吗？
DOS命令不是很熟悉.

P.S 动态把代码写到外部BAT档是最后的选择

目前暂时用脱裤子放屁的方法

拉个Timer设定程序被启动后开始每秒扫描一次行程
一直扫到行程结束等于扫不到指定行程时
再跳出讯息框提示运行结束

不用这样吧。

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Const INFINITE As Long = &HFFFF      '  Infinite timeout

Private Sub Form_Activate()
    Dim pID As Long
    Dim hProcess As Long
    pID = Shell("cmd", vbNormalFocus)
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pID)
    Debug.Assert hProcess
    WaitForSingleObject hProcess, INFINITE
    CloseHandle hProcess
    Unload Me
End Sub

1。脱裤子放屁作法已经完成了～
2。版大这段要等回公司才能试～看起来有点像是监视CMD视窗的东西～

3。依据上一个的问题得到的一个答案～DOS命令和BAT命令写法是一样的～

加上之前同事有试出如何使用Shell运行BAT后程序维持单行程状态～
而非另外添加另一个行程的用法的DOS命令～

就是说执行到Shell后VB6会等待Shell内呼叫的程序执行完毕后～
才会有回传值～而再让VB6继续往下跑的意思～有这种DOS命令～

所以应该也可以加到的VB6里使用～

脱裤子放屁作法其中一小段～主要只是控制按钮能否点击～
虽然能用但是还不太满意～太长～只是先求有再求好了～

Private Sub CmdStart_Click()
Dim i As Long, j As Long, k As Long
Dim KTPComLine As String, XMLComLine As String, LOGComLine As String, TempPath As String
Dim Answer As Integer

    If IsFolderExist(TargetPath) = False Then MkDir TargetPath
    If IsFolderExist(TargetPath & LOTNO) = False Then MkDir TargetPath & LOTNO
    
    i = Shell("C:\Program Files\WinRAR\WinRAR.exe E " & LogZip & " " & TargetPath & LOTNO & "\", vbNormalFocus)
    TempPath = Mid$(App.Path, 1, InStrRev(App.Path, "\"))
    
    If i <> 0 Then
        Answer = MsgBox("Start Run " & EXEVer & " ?", vbYesNo, EXEVer)
        If (Answer = vbYes) Then
            If IsFileExist(TempPath & EXEVer) = True Then
                If i <> 0 Then
                    KTPComLine = TempPath & "KTP\" & PRODUCT & ".KTP"
                    txtKTP.ToolTipText = Trim$(KTPComLine)
                    XMLComLine = txtXML
                    LOGComLine = GetLOG(TargetPath & LOTNO)
                    If IsFileExist(KTPComLine) = True And IsFileExist(XMLComLine) = True And IsFileExist(LOGComLine) = True Then
                        If i <> 0 Then
                            CmdTarget.Enabled = False: CmdStart.Enabled = False
                            j = Shell(TempPath & EXEVer & " " & KTPComLine & " " & XMLComLine & " " & LOGComLine, vbNormalFocus)
                            Timer1.Enabled = True
                        Else
                            MsgBox EXEVer & "Start Error !"
                        End If
                    Else
                        If IsFileExist(KTPComLine) <> True Then MsgBox "Can't Find " & KTPComLine
                        If IsFileExist(XMLComLine) <> True Then MsgBox "Can't Find " & XMLComLine
                        If IsFileExist(LOGComLine) <> True Then MsgBox "Can't Find " & LOGComLine
                    End If
                End If
            Else
                MsgBox "Can't Find " & TempPath & EXEVer
            End If
        End If
    End If
    
End Sub

Private Sub Timer1_Timer()
    If Timer1.Enabled = True Then
        If CheckProcess(EXEVer) = False Then
            MsgBox "Transform OK !"
            CmdTarget.Enabled = True: CmdStart.Enabled = True
            Timer1.Enabled = False
        End If
    End If
End Sub

原本是Kill Process的功能硬改成CheckProcess的功能

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * 260
End Type

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Public Function CheckProcess(NameProcess As String) As Boolean
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const TH32CS_SNAPPROCESS As Long = 2&
Dim uProcess  As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExename As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
Dim WinDirEnv As String
        
    CheckProcess = True
    
    If NameProcess <> "" Then
        AppCount = 0
        
        uProcess.dwSize = Len(uProcess)
        hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
        RProcessFound = ProcessFirst(hSnapshot, uProcess)
        
        Do
            i = InStr(1, uProcess.szexeFile, Chr(0))
            SzExename = LCase$(Left$(uProcess.szexeFile, i - 1))
            WinDirEnv = Environ("Windir") + "\"
            WinDirEnv = LCase$(WinDirEnv)
            
            If Right$(SzExename, Len(NameProcess)) = LCase$(NameProcess) Then
'                AppCount = AppCount + 1
'                MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
'                AppKill = TerminateProcess(MyProcess, ExitCode)
'                Call CloseHandle(MyProcess)
                CheckProcess = True
            Else
                CheckProcess = False
            End If
            
            RProcessFound = ProcessNext(hSnapshot, uProcess)
            
        Loop While RProcessFound
          
        Call CloseHandle(hSnapshot)
    End If
End Function

[ 本帖最后由 wube 于 2012-8-2 09:25 编辑 ]