- 浏览: 167788 次
- 性别:
- 来自: 广州
文章分类
最新评论
-
xiangyufangai:
很好很强大膜拜中哈哈!!
VB 两个字符串处理函数(类似Left/Mid/Right/Split的结合) -
hellohank:
这个……叫摘要算法,不叫加密算法~
Java实现的加密工具类(支持MD5和SHA) -
NIUCH1029291561:
接口有问题奥
网银在线支付接口和应用 -
yeuego:
能幫你就行了
MySQL索引分析 -
ForgiDaved:
很给力的介绍。记得前段时间给一个系统加功能,设计的表没有 ...
MySQL索引分析
Option Explicit
Private Declare Function CreatePipe _
Lib "kernel32" (phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long) As Long
Private Declare Function CreateProcess _
Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function TerminateProcess _
Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode 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, _
lpOverlapped As Any) As Long
Private Declare Function WriteFile _
Lib "kernel32" (ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
lpOverlapped As Any) As Long
Private Declare Function GetFileSize _
Lib "kernel32" (ByVal hFile As Long, _
lpFileSizeHigh As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError _
Lib "kernel32" () As Long
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (ByVal Destination As String, _
ByVal Source As String, _
ByVal Length As Long)
Private Declare Function lstrLen _
Lib "kernel32" _
Alias "lstrlenA" (ByVal lpString As String) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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 Const STARTF_USESTDHANDLES = &H100
Private Const STARTF_USESHOWWINDOW = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20
Dim hReadPipe As Long
Dim hWritePipe As Long
Dim hReadFile As Long
Dim hWriteFile As Long
Dim pi As PROCESS_INFORMATION
Private Const Pipe_Max_Length As Long = 65536 '64K的空间
Public Function CreateProcessWithPipe(Optional ByVal FileName As String = "cmd.exe") As Boolean
On Error GoTo ErrHdl
Dim ret&
Dim sa As SECURITY_ATTRIBUTES
With sa
.nLength = Len(sa)
'.bInheritHandle = False
.bInheritHandle = True
.lpSecurityDescriptor = 0
End With
'create two pipe->one for input & output and another for err handle
ret = CreatePipe(hReadPipe, hWriteFile, sa, Pipe_Max_Length): If ret = 0 Then Call RaiseErr
ret = CreatePipe(hReadFile, hWritePipe, sa, Pipe_Max_Length): If ret = 0 Then Call RaiseErr
'since now , we had create two pipes.
Dim si As STARTUPINFO
'fill start info
With si
.cb = Len(si)
.hStdInput = hReadPipe
.hStdOutput = hWritePipe
.hStdError = hWritePipe
'in fact. both error msg and normal msg r msg, so we can let then in a same handle
.wShowWindow = 0 'hide it
.dwFlags = STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW 'use handles, to make our hstd*** avable. use showwindow, to make our wShowWindow setting avable
End With
'createprocess----normally,it should be cmd.
ret = CreateProcess(vbNullString, FileName, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, App.Path, si, pi): If ret = 0 Then Call RaiseErr
CreateProcessWithPipe = True
Exit Function
ErrHdl:
Call TerminateProcessAndClosePipe
CreateProcessWithPipe = False
End Function
Public Function GetStringFromPipe() As String
On Error GoTo ErrHdl
Dim ret&
Dim sBuffer As String
Dim lRead As Long
Dim sReturn As String
sBuffer = Space$(Pipe_Max_Length)
ret = ReadFile(hReadFile, sBuffer, Len(sBuffer), lRead, ByVal 0&) 'lRead is bytes that had read actully
sReturn = Space$(lRead)
CopyMemory sReturn, sBuffer, lRead
GetStringFromPipe = sReturn
Exit Function
ErrHdl:
GetStringFromPipe = ""
End Function
Public Function PipeIsNull() As Boolean
PipeIsNull = (GetFileSize(hReadFile, 0&) <= 0)
End Function
Public Function PutStringToPipe(ByVal StrToPut As String) As Boolean
On Error GoTo ErrHdl
'most of time, u need to append a vbCrLf after the string u want to put.
Dim ret&
Dim lWrittenBytes As Long
ret = WriteFile(hWriteFile, StrToPut, lstrLen(StrToPut), lWrittenBytes, ByVal 0&): If ret = 0 Then Call RaiseErr
PutStringToPipe = (lWrittenBytes = Len(StrToPut))
Debug.Print hWriteFile
Exit Function
ErrHdl:
PutStringToPipe = False
End Function
Public Function TerminateProcessAndClosePipe() As Boolean
On Error GoTo ErrHdl
Dim ret&
ret = TerminateProcess(pi.hProcess, 0): If ret = 0 Then Call RaiseErr
ret = CloseHandle(hReadPipe): If ret = 0 Then Call RaiseErr
ret = CloseHandle(hReadFile): If ret = 0 Then Call RaiseErr
ret = CloseHandle(hWritePipe): If ret = 0 Then Call RaiseErr
ret = CloseHandle(hWriteFile): If ret = 0 Then Call RaiseErr
TerminateProcessAndClosePipe = True
Exit Function
ErrHdl:
TerminateProcessAndClosePipe = False
End Function
Private Sub RaiseErr()
On Error Resume Next
Err.Raise vbObjectError + 1 'raise an error so that to be caught by errhdl
End Sub
发表评论
-
vb 启动外部程序并且模拟鼠标点击
2011-03-09 13:28 1080Imports System.Runtime.InteropS ... -
VB 列出SQL数据库中所有表及字段信息
2011-03-09 13:24 1102程序思想:用Select name From sysobje ... -
VB 纯代码实现Timer控件的功能
2011-03-09 13:23 1246本博客有一篇类似的文章《VB 中运用 TimeSetEvent ... -
VB 控制音量
2011-03-09 13:22 1194'按钮一是音量增加,按钮二是音量减少,按钮三是静音切换. ... -
拦截 VB TextBox 双击消息
2011-03-09 13:22 922我们都知道在VB中TextBox默认是没有双击消息过程的(也就 ... -
VB 获取/设置屏幕分辨率
2011-03-09 13:21 1067Option ExplicitPrivate Decla ... -
VB 将数据快速导入EXCEL
2011-03-09 13:21 991Public Function ToExcel()On ... -
VB 建立快捷方式
2011-03-09 13:20 760Private Declare Function fCr ... -
VB 获取快捷方式原文件路径
2011-03-09 13:20 894'此方法不需要引用IShellLink.Private ... -
VB 的一组字符串转换函数
2011-03-09 13:20 752Public Function chrConvert(s ... -
VB 在浏览目录时指定初始目录
2011-03-09 13:19 972'VB也可以使用CallBack,下面是一个例子: '先 ... -
VB 获得鼠标滚轮的事件
2011-03-09 13:18 948'窗体代码Private Sub Form_Load() ... -
VB 比较两组字符串
2011-03-09 13:18 1237【方法一】 StrComp(string1, Stri ... -
VB 用API下载文件实例
2011-03-09 13:17 771'########################### ... -
VB 窗口处理技巧大全
2011-03-09 13:17 755VB提供了API函数SetWindowLong和GetWind ... -
VB 实现屏幕右下角浮出式消息窗口,透明淡出效果。
2011-03-09 13:16 922'任务栏高度[此部分相关代码转载自 枕善居]Privat ... -
VB Filter 函数用法
2011-03-09 13:16 1898例子1:Dim aa(10) As StringDim bbD ... -
VB 在EXPLORER进程崩溃之后重建托盘图标
2011-03-09 13:15 818重点为:向系统注册“TaskbarCreated”消息 ... -
Shell 调用程序后等待该程序结束后返回继续
2011-03-09 13:15 1192方法1: Private Declare Functi ... -
VB 最简单的WAV声音或音乐文件播放的代码
2011-03-09 13:14 1339'最简单的WAV声音或音乐文件播放的代码'API声明Pr ...
相关推荐
vb 常用icon图标,个性化自己的程序必备
TVideoGrabber_10.6.2.2_CSharp-VB.NET_Downloadly.ir.rar
vbAPI_windows_VSS.rarvbAPI_windows_VSS.rarvbAPI_windows_VSS.rarvbAPI_windows_VSS.rar
IISBACK.VB_,IISEXT.VB_,IISAPP.VB_,IISCFG.DL_,IISCLEX4.DL_,IISCNFG.VB_,IISDG.CH_,IISEXT.DL_
VB6_SGrid_2_Demonstration_vb6_源码.zip
VB_barcode_vb.net_源码.zip
6502反汇编软件VB代码_VBDASM.rar
精简版Vb_v6.rar
VB图标集锦_VB图标_图标_vb图标_资源_VB_源码.zip
Visual Basic 6编写的利用SQL语句操作数据库的例子。文件名是VB6_SQL.RAR.
vb6_downcc.zip
vbScrolltext_VB源码_源码.zip
VBremotedata_VB源码_源码.zip
videocap_VB源码_源码.zip
IISRG.CH_,IISFTP.VB_,IISFTPDR.VB_,IISLOG.DL_,IISMAP.DL_,IISMUI.DL_,IISNTS.CH_,IISPWCHG.DL_,IISRES.DL_,IISRESET.EX_
GoogleMap_TheWork_vb.net_源码.zip
USBHID_USBVB_VBUSB_vbhid_VB6.0_源码.zip
例程及说明:GTS-VB系列多轴运动控制器_gts_固高_运动控制VB_VB控制_源码.rar
JEE电机控制器台架调试界面V3_train465_can上位机_VB控制_vb电机_VB_源码.zip
JEE电机控制器台架调试界面V3_train465_can上位机_VB控制_vb电机_VB_源码.rar