科技行者

行者学院 转型私董会 科技行者专题报道 网红大战科技行者

知识库

知识库 安全导航

至顶网软件频道如何用VB做一个刷屏器

如何用VB做一个刷屏器

  • 扫一扫
    分享文章到微信

  • 扫一扫
    关注官方公众号
    至顶头条

如何用VB做一个刷屏器

作者:www.chinaitpower.com 来源:www.chinaitpower.com 2007年9月11日

关键字: 技巧 IBM lotus VB Office

  • 评论
  • 分享微博
  • 分享邮件

首先你要查找所有窗口标题 
Dim key, bs1, bs2, kb 

Sub FindTitle() 

'查找桌面上的所有窗口标题 

Dim currwnd As Integer 

Combo1.Clear 

currwnd = GetWindow(hwnd, GW_HWNDFIRST) 

While currwnd <> 0 

length = GetWindowTextLength(currwnd) 

listitem$ = Space$(length + 1) 

length = GetWindowText(currwnd, listitem$, length + 1) 

If length > 0 Then 

Combo1.AddItem listitem$ 

End If 

currwnd = GetWindow(currwnd, GW_HWNDNEXT) 

If Combo1.ListCount > 0 Then 

Combo1.Text = Combo1.List(0) 

Combo1.ListIndex = 0 

Else 

'MsgBox "没有发现可活动的窗口", 16, "活动" 

End If 
DoEvents 
Wend 
If Combo1.ListCount > 0 Then 

Combo1.Text = Combo1.List(0) 

Combo1.ListIndex = 0 

Else 

MsgBox "没有发现可活动的窗口", 16, "活动" 

End If 
End Sub 


------ 
测试窗口能否活动 

Sub Sift() 

'测试窗口能否活动 

i = 0 

Combo2.Clear 

Do 

On Local Error Resume Next 

AppActivate Combo1.List(i) 

If Err = 0 Then 

Combo2.AddItem Combo1.List(i) 

End If 

i = i + 1 

Loop Until i = Combo1.ListCount - 1 

AppActivate Form1.Caption 

If Combo2.ListCount > 0 Then 

Combo2.Text = Combo2.List(0) 

Combo2.ListIndex = 0 

Else 

MsgBox "没有发现可活动窗口", 16, "活动" 

End If 

End Sub 

制作一个模块 
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long 

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 
Declare Function inigetstr Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long 
Declare Function iniwritestr Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long 
Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) 
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long 
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long 
'Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 

Public Const GW_HWNDFIRST = 0 

Public Const GW_HWNDLAST = 1 

Public Const GW_HWNDNEXT = 2 

Public Const GW_HWNDPREV = 3 

Public Const GW_OWNER = 4 

Global wb As String 
'--------- 

Option Explicit 

Public OldWindowProc As Long 
Public TheForm As Form 
Public TheMenu As Menu 

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long 
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 

Public Const WM_USER = &H400 
Public Const WM_LBUTTONUP = &H202 
Public Const WM_MBUTTONUP = &H208 
Public Const WM_RBUTTONUP = &H205 
Public Const TRAY_CALLBACK = (WM_USER + 1001&) 
Public Const GWL_WNDPROC = (-4) 
Public Const GWL_USERDATA = (-21) 
Public Const NIF_ICON = &H2 
Public Const NIF_TIP = &H4 
Public Const NIM_ADD = &H0 
Public Const NIF_MESSAGE = &H1 
Public Const NIM_MODIFY = &H1 
Public Const NIM_DELETE = &H2 
Public Const SPI_SCREENSAVERRUNNING = 97& 
Public Type NOTIFYICONDATA 
    cbSize As Long 
    hwnd As Long 
    uID As Long 
    uFlags As Long 
    uCallbackMessage As Long 
    hIcon As Long 
    szTip As String * 64 
End Type 

Private TheData As NOTIFYICONDATA 
' ********************************************* 
' The replacement window proc. 
' ********************************************* 
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    If Msg = TRAY_CALLBACK Then 
        ' The user clicked on the tray icon. 
        ' Look for click events. 
        If lParam = WM_LBUTTONUP Then 
            ' On left click, show the form. 
            If TheForm.WindowState = vbMinimized Then _ 
                TheForm.WindowState = 0 
            TheForm.SetFocus 
            Exit Function 
        End If 
        If lParam = WM_RBUTTONUP Then 
            ' On right click, show the menu. 
            TheForm.PopupMenu TheMenu 
            Exit Function 
        End If 
    End If 
     
    ' Send other messages to the original 
    ' window proc. 
    NewWindowProc = CallWindowProc( _ 
        OldWindowProc, hwnd, Msg, _ 
        wParam, lParam) 
End Function 
' ********************************************* 
' Add the form's icon to the tray. 
' ********************************************* 
Public Sub AddToTray(frm As Form, mnu As Menu) 
    ' ShowInTaskbar must be set to False at 
    ' design time because it is read-only at 
    ' run time. 

    ' Save the form and menu for later use. 
    Set TheForm = frm 
    Set TheMenu = mnu 
     
    ' Install the new WindowProc. 
    OldWindowProc = SetWindowLong(frm.hwnd, _ 
        GWL_WNDPROC, AddressOf NewWindowProc) 
     
    ' Install the form's icon in the tray. 
    With TheData 
        .uID = 0 
        .hwnd = frm.hwnd 
        .cbSize = Len(TheData) 
        .hIcon = frm.Icon.Handle 
        .uFlags = NIF_ICON 
        .uCallbackMessage = TRAY_CALLBACK 
        .uFlags = .uFlags Or NIF_MESSAGE 
        .cbSize = Len(TheData) 
    End With 
    Shell_NotifyIcon NIM_ADD, TheData 
End Sub 
' ********************************************* 
' Remove the icon from the system tray. 
' ********************************************* 
Public Sub RemoveFromTray() 
    ' Remove the icon from the tray. 
    With TheData 
        .uFlags = 0 
    End With 
    Shell_NotifyIcon NIM_DELETE, TheData 
     
    ' Restore the original window proc. 
    SetWindowLong TheForm.hwnd, GWL_WNDPROC, _ 
        OldWindowProc 
End Sub 
' ********************************************* 
' Set a new tray tip. 
' ********************************************* 
Public Sub SetTrayTip(tip As String) 
    With TheData 
        .szTip = tip & vbNullChar 
        .uFlags = NIF_TIP 
    End With 
    Shell_NotifyIcon NIM_MODIFY, TheData 
End Sub 
' ********************************************* 
' Set a new tray icon. 
' ********************************************* 
Public Sub SetTrayIcon(pic As Picture) 
    ' Do nothing if the picture is not an icon. 
    If pic.Type <> vbPicTypeIcon Then Exit Sub 

    ' Update the tray icon. 
    With TheData 
        .hIcon = pic.Handle 
        .uFlags = NIF_ICON 
    End With 
    Shell_NotifyIcon NIM_MODIFY, TheData 
End Sub 




Public Sub AllowKeys(bParam As Boolean) 

Dim lRetVal As Long, bOld As Boolean 

lRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING, bParam, bOld, 0&) 

End Sub 

-------- 
其他的一些具体操作可以按照你自己的思路来

    • 评论
    • 分享微博
    • 分享邮件
    闂傚倸鍊搁崐鎼佸磹閹间礁纾瑰瀣椤愪粙鏌ㄩ悢鍝勑㈤柣顓燁殜楠炴牕菐椤掆偓婵¤偐绱掗幇顓ф疁闁哄矉绻濆畷鍫曞煛娴i攱鐫忛梻浣告惈椤戝懘鏌婇敐澶婅摕闁哄浄绱曢悿鈧柣搴秵娴滅偞绂掗悙顒傜瘈婵炲牆鐏濋悘鐘绘煏閸喐鍊愮€殿喖顭峰鎾晬閸曨厽婢戦梺璇插嚱缂嶅棙绂嶉弽顓炵;闁规崘顕ч崘鈧銈嗘尪閸斿海绮欒箛娑欌拺閻犳亽鍔屽▍鎰版煙閸戙倖瀚�

    濠电姷鏁告慨鐑藉极閸涘﹥鍙忛柣鎴濐潟閳ь剙鍊圭粋鎺斺偓锝庝簽閸旓箑顪冮妶鍡楀潑闁稿鎹囬弻娑㈡偄闁垮浠撮梺绯曟杹閸嬫挸顪冮妶鍡楀潑闁稿鎸剧槐鎾愁吋閸滃啳鍚Δ鐘靛仜閸燁偉鐏掗柣鐘叉穿鐏忔瑧绮i悙鐑樷拺鐟滅増甯掓禍浼存煕閹惧娲撮柟顔藉劤鐓ゆい蹇撴噳閹锋椽姊婚崒姘卞闁告娲熷畷濂稿Ψ閵壯勭叄婵犵數濮撮敃銈団偓姘煎弮瀹曪綀绠涢弮鍌滅槇婵犵數濮撮崐缁樻櫠濞戙垺鐓曢悗锝冨妼婵′粙鏌曢崶褍顏€殿喕绮欐俊姝岊槹闁逞屽墯鐢繝寮婚悢鍏煎癄濠㈣泛锕ュ▓濠氭⒑閸濆嫮鐏遍柛鐘崇墵楠炲啫饪伴崼婵堝幐闂佺ǹ鏈粙鎾广亹鐎n喗鐓熼幖娣€ゅḿ鎰箾閸欏顏堟偩濠靛牏鐭欓悹鎭掑妽濞堥箖姊洪崜鎻掍簼婵炲弶鐗犻幃鈥斥槈閵忥紕鍘遍柣蹇曞仜婢т粙鎯岀€n偆绠鹃柛顐ゅ枑閸婃劖鎱ㄦ繝鍕笡闁瑰嘲鎳愮划鐢碘偓锝庝簼閻d即姊绘担瑙勫仩闁告柨顑夊畷锟犲礃閼碱剚娈鹃梺闈涚箞閸婃洟宕橀埀顒€顪冮妶鍡楀闁稿骸宕惃顒勬⒒閸屾瑧鍔嶉悗绗涘懐鐭欓柟瀵稿Л閸嬫挸顫濋悡搴$睄閻庤娲戦崡鍐茬暦閸楃倣鐔兼⒐閹邦喚娉块梻鍌欑窔濞佳囨偋閸℃稑绠犻幖娣灪閸欏繑銇勯幒鍡椾壕闂佸疇顫夐崹鍧楀春閵夆晛骞㈡俊鐐插⒔閸戣绻濋悽闈浶為柛銊︽そ閺佸鏌ч懡銈呬沪濞e洤锕俊鍫曞川椤斿吋顏¢梻浣呵归鍛村磹閸︻厽宕叉繛鎴欏灩楠炪垺淇婇婵愬殭缁炬澘绉归弻锝嗘償閵忥絽顥濆銈忓閺佽顕g拠宸悑闁割偒鍋呴鍥⒒娴e憡鍟為柟鎼佺畺瀹曠増鎯旈…鎴炴櫔闂佹寧绻傞ˇ浠嬪极閸℃ぜ鈧帒顫濋濠傚闂佹椿鍘介〃鍡欐崲濞戙垹绠婚柡澶嬪灩閸斾即姊虹粙娆惧剱闁圭懓娲濠氭晲閸涱亝顫嶅┑鐐叉閸旀洜澹曢幎鑺モ拺闁告繂瀚﹢鎵磼鐎n偄鐏撮柛鈺冨仱楠炲鏁冮埀顒€顔忓┑鍥ヤ簻闁哄洨鍋為崳娲煃鐠囪鍔熺紒杈ㄦ崌瀹曟帒鈻庨幋婵嗩瀴婵$偑鍊戦崝宀勫箠濮椻偓楠炲棗鐣濋崟顐わ紲闂佺粯鍔欏ḿ褏绮婇敃鍌涚厵闁稿繗鍋愰弳姗€鏌涢弬璺ㄧ劯闁诡喚鍋ゅ畷褰掝敃閻樿京鐩庨梻浣告贡閸庛倝宕归悽鍓叉晜闁冲搫鎳忛崐鍨叏濮楀棗澧绘俊鎻掔秺閺屾洟宕惰椤忣厾鈧鍠曠划娆愪繆濮濆矈妲奸梺闈╃祷閸庡磭妲愰幘瀛樺缂佹稑顑呭▓顓炩攽閳藉棗浜濈紒璇茬墕椤曪絾绻濆顓炰簻缂佺偓濯芥ご鎼佸疾閿濆鍋℃繝濠傚暟鏁堥梺璇″枟閿曘垽骞婇悩娲绘晢闁稿本绮g槐鏌ユ⒑閸濆嫷妲搁柣妤€瀚板畷婵囨償閿濆洣绗夐梺缁樺姉閸庛倝鎮″☉銏″€堕柣鎰硾琚氶梺鍝ュУ閿曘垽寮婚埄鍐╁闁荤喐婢橀~鎺楁倵鐟欏嫭绀堥柛鐘崇墵閵嗕礁顫滈埀顒勫箖閳哄懏鎯炴い鎰╁€濋幏濠氭⒒閸屾艾鈧嘲霉閸パ呮殾闁割煈鍋呴崣蹇涙煙閹澘袚闁抽攱姊婚埀顒€绠嶉崕閬嵥囬鐐插瀭闁稿瞼鍋為悡銏′繆椤栨粌鐨戠紒杈ㄥ哺閺屻劌鈹戦崱鈺傂︾紓浣插亾閻庯綆鍋佹禍婊堟煛瀹ュ啫濡块柍钘夘槹缁绘盯宕奸悢铏圭厜濠殿喖锕ㄥ▍锝呪槈閻㈢ǹ宸濇い鏂惧嫎閳ь剚鍔曢—鍐Χ鎼粹€茬凹濠电偠灏欓崰鏍х暦濞差亜鐒垫い鎺嶉檷娴滄粓鏌熼崫鍕棞濞存粓绠栧娲箰鎼淬垻鈹涙繝纰樷偓铏悙閸楅亶鏌熼悧鍫熺凡缂侇偄绉归弻娑㈩敃閿濆洨鐣煎銈嗘尰濡炶棄顫忛搹鍦<婵☆垰鎼~宀勬倵濞堝灝娅橀柛鎾寸懆閻忓啴姊洪崨濠佺繁闁哥姵宀稿畷銏ゅ箹娴e厜鎷洪梺鍛婃尰瑜板啯绂嶆禒瀣厱閻庯綆浜滈顓㈡煙椤旀枻鑰块柡浣稿暣瀹曟帒鈽夊顒€绠為梻浣筋嚙閸戠晫绱為崱娑樼;闁糕剝蓱濞呯姵銇勯幒鎴濃偓鑽ゅ婵傚憡鐓曢悘鐐插⒔閳藉绱掑锕€娲﹂悡娆撴煟閻斿憡绶叉い蹇e弮閺岀喖鎮℃惔銏g闂佺懓寮堕幐鍐茬暦閻斿吋顥堟繛鎴炵懄閻濓繝姊婚崒姘偓鎼佸磹妞嬪海鐭嗗〒姘e亾妤犵偞鐗犻、鏇㈠Χ閸屾矮澹曞┑顔矫畷顒勫储鐎电硶鍋撶憴鍕缂傚秴锕濠氬幢濡ゅ﹤鎮戦梺鍛婁緱閸ㄧ晫妲愰柆宥嗙厽閹艰揪绱曢悾顓㈡煕鎼淬劋鎲鹃挊婵喢归崗鍏肩稇缁炬崘娉曢埀顒€绠嶉崕閬嵥囨导瀛樺亗闁哄洢鍨洪悡娑㈡煕閵夛絽鍔氬┑锛勫帶椤儻顧侀柛銊ゅ嵆濠€渚€姊虹紒妯撳湱绮旈鈧、鏃堝醇閻旇櫣鏆㈤梻鍌氬€烽悞锔锯偓绗涘懏宕查柛灞绢嚤濞戞鏃堝川椤撶姴骞掗梻浣告惈濞层垽宕瑰ú顏呭亗闁告劦浜濋崰鎰節婵犲倻澧曠紒鈧崼鐔稿弿婵☆垱瀵х涵楣冩煢閸愵亜鏋涢柡灞炬礃缁绘稖顦查悗姘卞厴瀹曟垿濡搁埡鍌楁嫼缂傚倷鐒﹂敋濠殿喖娲﹂妵鍕即閵娿儱绫嶉梺绯曟杺閸ㄨ棄顕i幘顔碱潊闁炽儲鏋奸崑鎾绘偨閸涘﹦鍙嗗┑鐘绘涧濡鍩€椤掑倹鍤€闁宠绉瑰畷鍫曞Ω閿濆嫮鐩庨梻濠庡亜濞诧妇绮欓幇鏉跨疅濡わ絽鍟悡娑㈡倶閻愰潧浜剧紒鈧€n兘鍋撶憴鍕濞存粌鐖奸妴浣割潨閳ь剟骞冮姀锛勯檮濠㈣泛顦辨径锟�

    重磅专题
    往期文章
    最新文章