开启辅助访问 切换到宽版

精易论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

用微信号发送消息登录论坛

新人指南 邀请好友注册 - 我关注人的新帖 教你赚取精币 - 每日签到


求职/招聘- 论坛接单- 开发者大厅

论坛版规 总版规 - 建议/投诉 - 应聘版主 - 精华帖总集 积分说明 - 禁言标准 - 有奖举报

查看: 3264|回复: 6
收起左侧

[精币悬赏] 哪个大神帮我把这个VB的代码转换成易语言代码,谢谢!

[复制链接]
结帖率:0% (0/2)
发表于 2012-9-8 18:41:11 | 显示全部楼层 |阅读模式   浙江省杭州市
33精币
Option ExplicitPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'加入托盘
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIM_ADD = &H0 '表示要往任务栏中加入图标
Public Const NIM_DELETE = &H2 '删除图标
Public Const NIM_MODIFY = &H1 '修改图标
Public Const NIF_ICON = &H2 '允许图标显示
Public Const NIF_MESSAGE = &H1 '允许图标消息转发
Public Const NIF_TIP = &H4 '允许图标显示图标提示字符串
Public Const WM_USER = &H400
Public Const WM_NOTIFYICON = WM_USER + 1          ' 自定义消息,用于子类化时,取得托盘相应信息
'托盘BOTTON
Public Const TBSTATE_HIDDEN = &H8
Public Const WM_SIZE = &H5
'Public Const WM_USER As Long = &H400
Public Const TB_BUTTONCOUNT As Long = (WM_USER + 24)
Public Const TB_HIDEBUTTON As Long = (WM_USER + 4)
Public Const TB_GETBUTTON As Long = (WM_USER + 23)
Public Const TB_GETBITMAP As Long = (WM_USER + 44)
Public Const TB_DELETEBUTTON As Long = (WM_USER + 22)
Public Const TB_ADDBUTTONS As Long = (WM_USER + 20)
Public Const TB_INSERTBUTTON As Long = (WM_USER + 21)
Public Const TB_GETBUTTONTEXTA As Long = (WM_USER + 45)
Public Const TB_ISBUTTONHIDDEN As Long = (WM_USER + 12)
Public Const TB_MOVEBUTTON = (WM_USER + 82)
Public Const TB_AUTOSIZE As Long = (WM_USER + 33)
Public Const ILD_NORMAL As Long = &H0
'进程读写
Public Const READ_CONTROL As Long = &H20000
Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Public Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Public Const STANDARD_RIGHTS_EXECUTE As Long = (READ_CONTROL)
Public Const STANDARD_RIGHTS_ALL As Long = &H1F0000
Public Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Public Const SYNCHRONIZE As Long = &H100000
Public Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Public Const PROCESS_TERMINATE As Long = (&H1)
'内存读写参数
Public Const PROCESS_VM_OPERATION As Long = (&H8)
Public Const PROCESS_VM_READ As Long = (&H10)
Public Const PROCESS_VM_WRITE As Long = (&H20)
Public Const MEM_RESERVE As Long = &H2000
Public Const MEM_COMMIT As Long = &H1000
Public Const MEM_RELEASE As Long = &H8000
Public Const PAGE_READWRITE As Long = &H4
'窗口状态参数
Public Const SW_HIDE = 0
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const PROCESS_QUERY_INFORMATION = 1024
'托盘
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
'ICON结构
Public Type ICONINFO
    fIcon           As Long
    xHotspot        As Long
    yHotspot        As Long
    hbmMask         As Long
    hbmColor        As Long
End Type
'Botton结构
Public Type TBBUTTON
    iBitmap         As Long
    idCommand       As Long
    fsState         As Byte
    fsStyle         As Byte
    bReserved1      As Byte
    bReserved2      As Byte
    dwData          As Long
    iString         As Long
End Type
''没有公开的TRAYDATA结构
Public Type TRAYDATA
    hWnd              As Long
    uid               As Long
    uCallBackMessage As Long
    Reserved1(0 To 1) As Long
    hIcon             As Long
    Reserved2(0 To 5) As Integer
    ExePath(0 To 255) As Byte
End Type
'自定义结构
Public Type TrayItemInfo
    hWnd             As Long
    uid              As Long
    hIcon            As Long
    uCallBackMessage As Long
    sTip             As String
    sProcessPath     As String
    lIdCommand       As Long
    bVisible         As Boolean
    IsSetHide        As Boolean
End Type
Public Const MAX_PATH& = 260
Public m_hTrayWnd As Long
Sub Main()
    Form1.Show
End Sub
'*************************************************************************
'**函 数 名:得到系统托盘句柄
'*************************************************************************
Public Function FindSysTray() As Long
    Dim hTrayWnd As Long
    hTrayWnd = FindWindow("Shell_TrayWnd", vbNullString)
    If hTrayWnd <> 0 Then
        hTrayWnd = FindWindowEx(hTrayWnd, 0, "TrayNotifyWnd", vbNullString)
        hTrayWnd = FindWindowEx(hTrayWnd, 0, "SysPager", vbNullString)
        If hTrayWnd <> 0 Then
            hTrayWnd = FindWindowEx(hTrayWnd, 0, "ToolbarWindow32", vbNullString)
        End If
    End If
    FindSysTray = hTrayWnd
End Function
'*************************************************************************
'**函 数 名:转换BYTE数组 及 去除最后的"\0"。
'*************************************************************************
Public Function DelEndNull(ByVal sSrc As String) As String
    Dim lNullpos As Long
    lNullpos = InStr(sSrc, Chr$(0))
    If lNullpos > 0 Then
        DelEndNull = Left$(sSrc, lNullpos - 1)
    Else
        DelEndNull = sSrc
    End If
End Function
'*************************************************************************
'**函 数 名:'去除路径中的??问号。
'*************************************************************************
Public Function CheckPath(ByVal sPath As String) As String
    On Error Resume Next
    sPath = Replace$(sPath, "\??\", "")
    If UCase$(Left$(sPath, 12)) = "\SYSTEMROOT\" Then sPath = GetWinDir & Mid$(sPath, 12)
    CheckPath = sPath
End Function
'*************************************************************************
'**函 数 名'得到系统路径
'*************************************************************************
Public Function GetWinDir() As String
    Dim sTemp As String * 256
    Dim iCharLen As Integer
    iCharLen = GetWindowsDirectory(sTemp, Len(sTemp))
    GetWinDir = Left$(sTemp, iCharLen)
End Function
'------------------------modIconToPic------------------------------------------------
Option Explicit
'网络上抄摘,原作者不详。
'把ICON文件转为一般图像文件与获取EXE文件的图标
'OleCreatePictureIndirect建立一个图像对象,并返回对象句柄
'pDicDesc 图象结构
'riid      接口的标识符
'fown      是否清除图像对象,如设置为真,则图片对象将摧毁它的图片当对象被摧毁时。如果假, 则由用户负责摧毁图片对象。
'lpUnk     输出变量地址接口类型
Public Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
Public Type TypeIcon
    cbSize    As Long                  '结构大小
    picType   As PictureTypeConstants '图像类型
    hIcon     As Long                  '图标句柄
End Type
'CLSID类标识符的缩写
Public Type CLSID
    id(16) As Byte '由16个成员组成的字节数组
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Type SHFILEINFO
    hIcon         As Long                '文件的图标句柄
    iIcon         As Long                '图标的系统索引号
    dwAttributes As Long                '文件的属性值
    szDisplayName As String * 260        '文件的显示名
    szTypeName    As String * 80         '文件的类型名
End Type
Public Const SHGFI_ICON = &H100         '获得图标
Public Const SHGFI_LARGEICON = &H0      '获取文件大图标
Public Const SHGFI_SMALLICON = &H1      '获取小图标
'ICON 转 Picture
Public Function IconToPic(hIcon As Long) As IPictureDisp
    Dim cls_id As CLSID
    Dim hRes As Long
    Dim new_icon As TypeIcon
    Dim lpUnk As IUnknown         'Com接口
    With new_icon
        .cbSize = Len(new_icon)
        .picType = vbPicTypeIcon 'Picture 对象的图标类型
        .hIcon = hIcon
    End With
    With cls_id
        .id(8) = &HC0
        .id(15) = &H46
    End With
    hRes = OleCreatePictureIndirect(new_icon, cls_id, 1, lpUnk)
    If hRes = 0 Then Set IconToPic = lpUnk
End Function
'获得文件ICON
Public Function GetExeIcon(FileName, Optional ByVal SmallIcon As Boolean = True) As IPictureDisp
    Dim Index As Integer
    Dim hIcon As Long
    Dim item_num As Long
    Dim icon_pic As IPictureDisp
    Dim sh_info As SHFILEINFO
    If SmallIcon = True Then
        SHGetFileInfo FileName, 0, sh_info, Len(sh_info), SHGFI_ICON + SHGFI_SMALLICON
    Else
        SHGetFileInfo FileName, 0, sh_info, Len(sh_info), SHGFI_ICON + SHGFI_LARGEICON
    End If
    hIcon = sh_info.hIcon
    Set icon_pic = IconToPic(hIcon)
    Set GetExeIcon = icon_pic
    Set icon_pic = Nothing
End Function
'*************************************************************************
'**函 数 名:通过PID返回程序路径
'*************************************************************************
Public Function GetAppPathByPid(lPid As Long) As String
    Dim sRet As String
    Dim lret As Long
    Dim lModules(1 To MAX_PATH) As Long
    Dim sModName As String
    Dim lCBSize As Long
    Dim hProcess As Long
    Dim sProcessPath As String
    sProcessPath = "[Unknown Process]"
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, lPid)
    If hProcess Then
        lret = EnumProcessModules(hProcess, lModules(1), MAX_PATH, lCBSize)
        If lret <> 0 Then
            sModName = Space$(MAX_PATH)
            lret = GetModuleFileNameExA(hProcess, lModules(1), sModName, 500) '从句柄的取得对应的程序路径
            sProcessPath = Left$(sModName, lret)
            sProcessPath = CheckPath(Trim$(sProcessPath)) '去除路径中\??\的内容
        End If
    End If
    GetAppPathByPid = sProcessPath
    CloseHandle hProcess
End Function
'-------------------------------form1---------------------------------------
Option Explicit
'*************************************************************************
'*************************************************************************
Private Declare Function GetLastError Lib "kernel32" () As Long
Private m_aTrayinfo() As TrayItemInfo
Private iIndex   As Integer
Public Sub Command1_Click()
    Dim lTrayPid As Long
    Dim lCount   As Long
    Dim lret     As Long
    Dim hProcess As Long
    Dim lAddress As Long
    Dim udtTb    As TBBUTTON
    Dim udtTray As TRAYDATA
    Dim udtTifo As TrayItemInfo
    Dim lTextAdr As Long
    Dim asTip(0 To 1024) As Byte
    Dim sTip    As String
    Dim icoInfo As ICONINFO
    Dim i       As Integer
    Set ListView1.Icons = Nothing
    Set ListView1.SmallIcons = Nothing
    ListView1.ListItems.Clear
    ImageList1.ListImages.Clear
    ImageList1.ImageHeight = 16
    ImageList1.ImageWidth = 16
    m_hTrayWnd = FindSysTray()
    lret = GetWindowThreadProcessId(m_hTrayWnd, lTrayPid)
    lCount = SendMessage(m_hTrayWnd, TB_BUTTONCOUNT, 0, ByVal 0&)
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, lTrayPid)
    lAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE)
    For i = 0 To lCount - 1
        lret = SendMessage(m_hTrayWnd, TB_GETBUTTON, ByVal i, ByVal lAddress&)
        lret = ReadProcessMemory(hProcess, ByVal lAddress, ByVal VarPtr(udtTb), ByVal Len(udtTb), ByVal 0&)
        lret = ReadProcessMemory(hProcess, ByVal udtTb.dwData, ByVal VarPtr(udtTray), ByVal Len(udtTray), ByVal 0&)
        udtTifo.sProcessPath = DelEndNull(udtTray.ExePath)
        If Not CBool((udtTb.fsState And TBSTATE_HIDDEN)) Then
            lret = ReadProcessMemory(hProcess, ByVal udtTb.iString, ByVal VarPtr(asTip(0)), ByVal 1024, ByVal 0&)
            sTip = DelEndNull(asTip)
        Else
            sTip = "[Hidden Icon]"
        End If
        With udtTifo
            .sTip = sTip
            .hWnd = udtTray.hWnd
            .uCallBackMessage = udtTray.uCallBackMessage
            .uid = udtTray.uid
            .bVisible = Not CBool((udtTb.fsState And TBSTATE_HIDDEN))
            .hIcon = udtTray.hIcon
        End With
        If GetIconInfo(udtTray.hIcon, icoInfo) <> 0 Then
            ImageList1.ListImages.Add , , IconToPic(udtTray.hIcon)
            'Debug.Print GetLastError
        Else
            ImageList1.ListImages.Add , , GetExeIcon(udtTifo.sProcessPath)
        End If
        Debug.Print sTip, GetLastError, i
        If ImageList1.ListImages.Count = 1 Then
            Set ListView1.Icons = ImageList1
            Set ListView1.SmallIcons = ImageList1
        End If
        ReDim Preserve m_aTrayinfo(0 To i)
        m_aTrayinfo(i) = udtTifo
        ListView1.ListItems.Add i + 1, , udtTifo.sTip, 1, i + 1
        ListView1.ListItems(i + 1).SubItems(1) = udtTifo.sProcessPath
    Next
    VirtualFreeEx hProcess, ByVal lAddress, ByVal 4096&, MEM_RELEASE
    CloseHandle hProcess

End Sub
Public Sub Command2_Click()
    Dim s As String
    iIndex = ListView1.SelectedItem.Index - 1
    s = ListView1.SelectedItem.Text
    Debug.Print s
    If iIndex > 0 And s <> "[Hidden Icon]" Then
        Call SendMessage(m_hTrayWnd, TB_MOVEBUTTON, iIndex, ByVal CLng(iIndex - 1))
        Call Command1_Click
        ListView1.SelectedItem = ListView1.ListItems(iIndex)
        ListView1.SelectedItem.EnsureVisible
        ListView1.SetFocus
    End If
End Sub
Public Sub Command3_Click()
    Dim s As String
    iIndex = ListView1.SelectedItem.Index - 1
    s = ListView1.SelectedItem.Text
    Debug.Print s
    If iIndex < ListView1.ListItems.Count - 1 And s <> "[Hidden Icon]" Then
        Call SendMessage(m_hTrayWnd, TB_MOVEBUTTON, iIndex, ByVal CLng(iIndex + 1))
        Call Command1_Click
        ListView1.SelectedItem = ListView1.ListItems(iIndex + 2)
        ListView1.SelectedItem.EnsureVisible
        ListView1.SetFocus
    End If
End Sub
Private Sub Command4_Click()
    iIndex = ListView1.SelectedItem.Index - 1
    Const WM_RBUTTONDOWN = &H204
    Const WM_RBUTTONUP = &H205
    Call PostMessage(m_aTrayinfo(iIndex).hWnd, m_aTrayinfo(iIndex).uCallBackMessage, m_aTrayinfo(iIndex).uid, WM_RBUTTONDOWN)
    Call PostMessage(m_aTrayinfo(iIndex).hWnd, m_aTrayinfo(iIndex).uCallBackMessage, m_aTrayinfo(iIndex).uid, WM_RBUTTONUP)
End Sub
Private Sub Command5_Click()
    Dim udtIconData As NOTIFYICONDATA
    iIndex = ListView1.SelectedItem.Index - 1
    If m_aTrayinfo(iIndex).bVisible Then
        With udtIconData
            .cbSize = Len(udtIconData)
            .hIcon = m_aTrayinfo(iIndex).hIcon
            .hWnd = m_aTrayinfo(iIndex).hWnd
            .szTip = m_aTrayinfo(iIndex).sTip
            .uCallBackMessage = m_aTrayinfo(iIndex).uCallBackMessage
            '*注:这要hIcon、szTip、uCallBackMessage对应相对应的值。这里我默认三者都有!
            .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
            .uid = m_aTrayinfo(iIndex).uid
        End With
        If m_aTrayinfo(iIndex).IsSetHide Then
            m_aTrayinfo(iIndex).IsSetHide = False
            Call Shell_NotifyIcon(NIM_ADD, udtIconData)
            Command5.Caption = "HIDE"
        Else
            m_aTrayinfo(iIndex).IsSetHide = True
            Call Shell_NotifyIcon(NIM_DELETE, udtIconData)
            Command5.Caption = "SHOW"
        End If
    End If
End Sub
Private Sub Form_Load()
    Call Command1_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim iIndex As Integer
    Dim udtIconData As NOTIFYICONDATA
    Cancel = 1
    For iIndex = 0 To UBound(m_aTrayinfo)
        If m_aTrayinfo(iIndex).IsSetHide Then
            With udtIconData
                .cbSize = Len(udtIconData)
                .hIcon = m_aTrayinfo(iIndex).hIcon
                .hWnd = m_aTrayinfo(iIndex).hWnd
                .szTip = m_aTrayinfo(iIndex).sTip
                .uCallBackMessage = m_aTrayinfo(iIndex).uCallBackMessage
                '*注:这要hIcon、szTip、uCallBackMessage对应相对应的值。这里我默认三者都有!
                .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
                .uid = m_aTrayinfo(iIndex).uid
            End With
            Call Shell_NotifyIcon(NIM_ADD, udtIconData)
        End If
    Next
    Cancel = 0
End Sub

结帖率:64% (30/47)
发表于 2012-9-8 18:44:50 | 显示全部楼层   山西省忻州市
看不懂,你说下功能,直接用易语言做
回复

使用道具 举报

结帖率:100% (4/4)
发表于 2012-9-8 19:16:57 | 显示全部楼层   广东省阳江市
用金山翻译啊 呵呵

点评

好狠- -   广西壮族自治区百色市  发表于 2012-9-8 20:18
回复

使用道具 举报

结帖率:0% (0/2)
 楼主| 发表于 2012-9-8 20:15:55 | 显示全部楼层   浙江省杭州市
我就是想打开YY语音时,隐藏它的托盘图标,可以理解?
回复

使用道具 举报

结帖率:40% (31/78)
发表于 2012-9-9 11:47:04 | 显示全部楼层   云南省昆明市
把他写成dll命令,然后用易语言调用。
回复

使用道具 举报

结帖率:0% (0/2)
 楼主| 发表于 2012-9-9 12:13:28 | 显示全部楼层   浙江省杭州市
嗯嗯  解决了  谢谢!
回复

使用道具 举报

结帖率:0% (0/2)
 楼主| 发表于 2012-9-9 12:13:54 | 显示全部楼层   浙江省杭州市
麻烦版主删除本帖!  谢谢!  
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则 致发广告者

发布主题 收藏帖子 返回列表

sitemap| 易语言源码| 易语言教程| 易语言论坛| 易语言模块| 手机版| 广告投放| 精易论坛
拒绝任何人以任何形式在本论坛发表与中华人民共和国法律相抵触的言论,本站内容均为会员发表,并不代表精易立场!
论坛帖子内容仅用于技术交流学习和研究的目的,严禁用于非法目的,否则造成一切后果自负!如帖子内容侵害到你的权益,请联系我们!
防范网络诈骗,远离网络犯罪 违法和不良信息举报电话0663-3422125,QQ: 793400750,邮箱:wp@125.la
Powered by Discuz! X3.4 揭阳市揭东区精易科技有限公司 ( 粤ICP备12094385号-1) 粤公网安备 44522102000125 增值电信业务经营许可证 粤B2-20192173

快速回复 返回顶部 返回列表