drwatson
دوشنبه 31 تیر 1387, 13:24 عصر
سلام
این سوال رو قبلا مطرح کردم ولی کسی جواب نداد
در سایت هم سرچ زدم بهترین مطلب رو آقای s_vb.max
سال 85 گفته بود که کدشو در زیر قرار دادم
این دستور برای همه فرامین داس عمل نمیکنه
فقط برا اونایی عمل میکنه که خودشون مستقل از کامند پرامپت اجرا میشن
مثل ping
حالا اگه از دوستان کسی راهی بلده یا میتونه این اشکال رو رفع کنه خواهشمندم
لطف کنه
چون خیلی لازمش دارم
متشکرم:لبخند:
Option ExplicitPrivate Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As LongPrivate Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPrivate Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As LongPrivate Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As LongEnd TypePrivate Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As LongEnd TypePrivate 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 Byte hStdInput As Long hStdOutput As Long hStdError As LongEnd TypePrivate Type OVERLAPPED ternal As Long ternalHigh As Long offset As Long OffsetHigh As Long hEvent As LongEnd TypePrivate Const STARTF_USESHOWWINDOW = &H1Private Const STARTF_USESTDHANDLES = &H100Private Const SW_HIDE = 0Private Const EM_SETSEL = &HB1Private Const EM_REPLACESEL = &HC2Private Sub Command1_Click() Command1.Enabled = False Redirect Text1.Text, Text2 Command1.Enabled = TrueEnd SubPrivate Sub Form_Load() Text1.Text = "ping"End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If Command1.Enabled = False Then Cancel = TrueEnd SubSub Redirect(cmdLine As String, objTarget As Object) Dim i%, t$ Dim pa As SECURITY_ATTRIBUTES Dim pra As SECURITY_ATTRIBUTES Dim tra As SECURITY_ATTRIBUTES Dim pi As PROCESS_INFORMATION Dim sui As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim lpBuffer(1024) As Byte pa.nLength = Len(pa) pa.lpSecurityDescriptor = 0 pa.bInheritHandle = True pra.nLength = Len(pra) tra.nLength = Len(tra) If CreatePipe(hRead, hWrite, pa, 0) > 0 Then sui.cb = Len(sui) GetStartupInfo sui sui.hStdOutput = hWrite sui.hStdError = hWrite sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES sui.wShowWindow = SW_HIDE If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) > 0 Then SetWindowText objTarget.hwnd, "" Do Erase lpBuffer() If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0) Then SendMessage objTarget.hwnd, EM_SETSEL, -1, 0 SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0) DoEvents Else CloseHandle pi.hThread CloseHandle pi.hProcess Exit Do End If CloseHandle hWrite Loop CloseHandle hRead End If End IfEnd Sub
این سوال رو قبلا مطرح کردم ولی کسی جواب نداد
در سایت هم سرچ زدم بهترین مطلب رو آقای s_vb.max
سال 85 گفته بود که کدشو در زیر قرار دادم
این دستور برای همه فرامین داس عمل نمیکنه
فقط برا اونایی عمل میکنه که خودشون مستقل از کامند پرامپت اجرا میشن
مثل ping
حالا اگه از دوستان کسی راهی بلده یا میتونه این اشکال رو رفع کنه خواهشمندم
لطف کنه
چون خیلی لازمش دارم
متشکرم:لبخند:
Option ExplicitPrivate Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As LongPrivate Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPrivate Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As LongPrivate Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As LongEnd TypePrivate Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As LongEnd TypePrivate 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 Byte hStdInput As Long hStdOutput As Long hStdError As LongEnd TypePrivate Type OVERLAPPED ternal As Long ternalHigh As Long offset As Long OffsetHigh As Long hEvent As LongEnd TypePrivate Const STARTF_USESHOWWINDOW = &H1Private Const STARTF_USESTDHANDLES = &H100Private Const SW_HIDE = 0Private Const EM_SETSEL = &HB1Private Const EM_REPLACESEL = &HC2Private Sub Command1_Click() Command1.Enabled = False Redirect Text1.Text, Text2 Command1.Enabled = TrueEnd SubPrivate Sub Form_Load() Text1.Text = "ping"End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If Command1.Enabled = False Then Cancel = TrueEnd SubSub Redirect(cmdLine As String, objTarget As Object) Dim i%, t$ Dim pa As SECURITY_ATTRIBUTES Dim pra As SECURITY_ATTRIBUTES Dim tra As SECURITY_ATTRIBUTES Dim pi As PROCESS_INFORMATION Dim sui As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim lpBuffer(1024) As Byte pa.nLength = Len(pa) pa.lpSecurityDescriptor = 0 pa.bInheritHandle = True pra.nLength = Len(pra) tra.nLength = Len(tra) If CreatePipe(hRead, hWrite, pa, 0) > 0 Then sui.cb = Len(sui) GetStartupInfo sui sui.hStdOutput = hWrite sui.hStdError = hWrite sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES sui.wShowWindow = SW_HIDE If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) > 0 Then SetWindowText objTarget.hwnd, "" Do Erase lpBuffer() If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0) Then SendMessage objTarget.hwnd, EM_SETSEL, -1, 0 SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0) DoEvents Else CloseHandle pi.hThread CloseHandle pi.hProcess Exit Do End If CloseHandle hWrite Loop CloseHandle hRead End If End IfEnd Sub