返回列表 回复 发帖

Visual Basic中实现I/O端口控制

VB没有提供直接读写I/O口的方法。所以只能借助其他语言来编写DLL,然后再在VB中调用。如果要在Windows 3.X下读写端口,也可以下载ftp://ftp.winsite.com/pub/pc/win31/programr/vbasic/portz10.zip,它是一个免费的VBX,可以通过读写VBX的属性来实现读写端口的操作,十分方便。
  如果你在Windows下使用过C/C++,那么编写这样的DLL可能没有什么困难。在C语言里都包括inp和outp函数。可以把下面这段C语言代码(32位)编译生成DLL,然后在VB中调用。
#include
#include
/*作用:从指定端口读入一个字节
参数:portid端口号
返回值:读入的字节*/
int _stdcall Inport(short portid)
{
 return inp(portid);}
 /*作用:向指定端口写入一个字节
 参数:portid端口号*/
 void _stdcall output(short portid,short byte)
 {
  outp(portid,byte);
 }
 /*作用:从指定端口读入一个字节
 参数:portid端口号
 返回值:读入的字节*/
 int _stdcall Inportw(short portid)
 {
  return inpw(portid);}
  /*作用:向指定端口写入一个字节
   参数:portid端口号*/
  void _stdcall Outportw(short portid,short word)
  {
   outpw(portid,(unsigned short) word);
  }  
  注意:这种方法只能用于Windows 95/98,不能用于Windows NT。
  VB6.0中DRAGDROP事件与DRAGOVER事件的使用
  在WINDOWS中,拖动意味着移动光标到对象上,按住鼠标,接着移动鼠标使对象在屏幕内滑动以重新定位对象。当释放鼠标按钮时,在拖动对象所在控件边界内放开鼠标会触发DragDrop事件。如果放开鼠标时对象不在一个控件的上面,那么对象定位于窗体本身。
  拖动对象的DragDrop事件不是用来存放有关放开对象时执行某些指令的地方。而应将这些指令放到背景的DragDrop事件中或者拖动对象所放开的目标控件中。
  一个DragDrop事件提供三条信息--DragDrop(Source as Control,X as Single,Y as Single)Source,是已经放开的图片,图标或控件。X和Y值,是放开事件所在目表对象的水平和垂直方向位置。如:
Sub pictrue1-DragDrop(Source as Control,X as Single,Y as Single)
Pictrue1.DrawWidth=6
picture1.pset(x,y),QBcolor(4)
End Sub  
  当一个控件拖动到另一个之上时,发生一个DragOver事件,以警告被入侵的控件或窗体发生了拖动。一个DragOver事件提供四条信息:
DragOver(Source as conterol,X as Single,Y as Single,State as Integer)
  "Source"为入侵者标志。入侵者在被入侵的控件或窗体内的当前位置由X,Y来确定入侵者的状态,如是否刚刚进入。仍在其内或将要离开等由State变量报告。
  通过允许用户拖动一个指针在屏幕上移动,接触窗口内的不同区域引起事情发生。一种常用的编程技术是和一状态栏一同使用。状态栏随程序运行时的情况而改变,报告光标的当前位置,变量如Font等的状态,提供一种有效的帮助功能。
  如何判断某一个Drive是否为光碟机?
  须调用 Windows API 的 GetDriveType ,首先 声 明 以 下 API :
Declare Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal nDrive As String) As Long  
  然后将以上的声明放在.bas的一般模块中,如果放在 Form 之中, 须在Declare之前再加上 Private。 然后使用以下叙述调用 :
  ret = GetDriveType ( "D:\")
  若传回值 ret 等于 5 , 即表示 "D:\" 为光碟机 , 至于其他传回值的意义则是 :
  2:软碟, 3:硬碟, 4:Server端磁碟, 6:RAMDISK。
  如何过滤键盘录入
  在 VB 的应用得到以前就处理键盘动作, 实现对键盘的全面控制, 可过滤任意的键。 下面的例子过滤了 CTRL+C 键, 并把该键模拟为在 Command1 上单击。
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "ostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WH_KEYBOARD = 2
Public Const KBH_MASK = &H20000000
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Global hHook As Long
'KeyboardProc 在 VB 应用动作前发生
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 If nCode >= 0 Then
  '处理你希望过滤的键
  If wParam = Asc("C") And (lParam And KBH_MASK) <> 0 Then
   If (lParam And &HC0000000) = 0 Then
    '模拟在Command1 中单击
    Form1.Command1.SetFocus
    Call PostMessage(Form1.Command1.hwnd, WM_LBUTTONDOWN, 0, &H20002)
    Call PostMessage(Form1.Command1.hwnd, WM_LBUTTONUP, 0, &H20002)
    KeyboardProc = 1
    Exit Function
   End If
  End If
 End If
 KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
 
Private Sub Form_Load()
 '将 KeyboardProc 连接到中断上
 hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0&, App.ThreadID)
End Sub
Private Sub Form_Unload(Cancel As Integer)
 Call UnhookWindowsHookEx(hHook)
End Sub  
  打印机技巧
  用 API 打开打印对话框
  使用通用对话框控件当然可以打开打印对话框, 不过要浪费更多的资源和增加了一个 OCX 部件。 而用 API 会高效。
  声明:
Declare Function PRINTDLG Lib "comdlg32.dll" Alias _
"rintDlgA" (pPrintdlg As PRINTDLG) As Long
 Type PRINTDLG
 lStructSize As Long
 hwndOwner As Long
 hDevMode As Long
 hDevNames As Long
 hdc As Long
 flags As Long
 nFromPage As Integer
 nToPage As Integer
 nMinPage As Integer
 nMaxPage As Integer
 nCopies As Integer
 hInstance As Long
 lCustData As Long
 lpfnPrintHook As Long
 lpfnSetupHook As Long
 lpPrintTemplateName As String
 lpSetupTemplateName As String
 hPrintTemplate As Long
 hSetupTemplate As Long
End Type  
  使用:
Private Sub Command1_Click()
 Dim p As PRINTDLG
 p.lStructSize = Len(p)
 p.hwndOwner = Me.hWnd
 p.nFromPage = 1
 p.nToPage = 1
 p.nMinPage = 1
 p.nMaxPage = 1
 p.nCopies = 1
 x = PRINTDLG(p)
 Printer.Print Text1.Text
End Sub  
  在打印字符串时自动换行
  其中 len1 为打印的宽度, Str 为打印的文本。
Do While Len(Str) > 0
 str1 = Str
 Do While len1 > 0 And Printer.TextWidth(str1) > len1
  str1 = Left(str1, Len(str1) - 1)
 Loop
 Printer.Print str1 '打印
 If Len(str1) = 0 Then Exit Do '不匹配
  Str = Mid(Str, Len(Str1)+1) '截断!
Loop  
  打印机只打印一行
  在 Win95 下,只有在使用 EndDoc 或 NewPage 时,打印机才开始打印,而且每次都要换页。使用以下的方法,可以只打印一行,并且可以把打印机的控制字符也直接发到打印机。
注意:如果打印机无汉字库,不能输出中文。
Open "RN" For Output As #1
Print #1, "一行"  
  如何改变 Windows 预设的打印机?
  在 VB 里面, 原本改变预设打印机的方法是:(假设安装有两种打印机(驱动程序))
Set Printer = Printers(0) ' 将预设打印机设定成第一种打印机
Set Printer = Printers(1) ' 将预设打印机设定成第二种打印机  
  但实际上以上叙述有时候不会成功(原因不详), 为了能够成功地改变预设打印机,以下是调用 Windows API 的方法:(补充说明: 此一解决方案适用于 Windows 95, 至于 NT 设定预设打印机的方法请叁考 98/04/05 的每周小技巧)
  1. API 的声明:
Const HWND_BROADCAST = &HFFFF&
Const WM_WININICHANGE = &H1A
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

  注:如果以上的声明放在「一般模块」底下, 应在 Const 之前加上 Public 保留字, 并且将 Private 保留字去掉。
  2. 程序范例:
PrinterName = "您想设定的打印机名称"
Dim S As String, length As Long, hKey As Long
S = String(80, Chr(0))
length = GetProfileString("devices", PrinterName, "", S, Len(S))
S = Left(S, length)
Call WriteProfileString("windows", "device", PrinterName & "," & S)
Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, &H7FFF&, ByVal "windows")
哈哈哈!!!!你的IP是不是?我都知道了!!!
返回列表