一个极其隐秘只有...吧 关注:2,380贴子:11,091
  • 2回复贴,共1

通用窗口化VBS脚本

只看楼主收藏回复

以前做的CF窗口化脚本,现在没用了
VBS不能直接用API,这是通过Excel用的
要成为一名出色的爱国者,就必须要成为他国人民的敌人,真是悲剧!——伏尔泰



1楼2012-01-28 16:14回复
    Option Explicit
    Dim WshShell
    Dim oExcel, oBook, oModule
    Dim strRegKey, strCode
    Set oExcel = CreateObject("Excel.Application")
    set WshShell = CreateObject("wscript.Shell")
    strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
    strRegKey = Replace(strRegKey, "$", oExcel.Version)
    WshShell.RegWrite strRegKey, 1, "REG_DWORD"
    Set oBook = oExcel.Workbooks.Add
    Set oModule = obook.VBProject.VBComponents.Add(1)
    strCode = _
    "Declare Function GetDesktopWindow Lib ""user32"" Alias ""GetDesktopWindow"" () As Long" & vbCr & _
    "Declare Function GetWindow Lib ""user32"" Alias ""GetWindow"" (ByVal hwnd As Long, ByVal wCmd As Long) As Long" & vbCr & _
    "Declare Function GetParent Lib ""user32"" Alias ""GetParent"" (ByVal hwnd As Long) As Long" & vbCr & _
    "Declare Function GetWindowText Lib ""user32"" Alias ""GetWindowTextA"" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long" & vbCr & _
    "Declare Function SetWindowLong Lib ""user32"" Alias ""SetWindowLongA"" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long" & vbCr & _
    "Declare Function SetWindowText Lib ""user32"" Alias ""SetWindowTextW"" (ByVal hwnd As Long, ByVal lpString As String) As Long" & vbCr & _
    "Declare Function EnumDisplaySettings Lib ""user32"" Alias ""EnumDisplaySettingsA"" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As DEVMODE) As Boolean" & vbCr & _
    "Declare Function ChangeDisplaySettings Lib ""user32"" Alias ""ChangeDisplaySettingsA"" (lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long" & vbCr & _
    "Type DEVMODE: dmDeviceName As String * 32: dmSpecVersion As Integer: dmDriverVersion As Integer: dmSize As Integer: dmDriverExtra As Integer: dmFields As Long: dmOrientation As Integer: dmPaperSize As Integer: dmPaperLength As Integer: dmPaperWidth As Integer: dmScale As Integer: dmCopies As Integer: dmDefaultSource As Integer: dmPrintQuality As Integer: dmColor As Integer: dmDuplex As Integer: dmYResolution As Integer: dmTTOption As Integer: dmCollate As Integer: dmFormName As String * 32: dmUnusedPadding As Integer: dmBitsPerPel As Integer: dmPelsWidth As Long: dmPelsHeight As Long: dmDisplayFlags As Long: dmDisplayFrequency As Long: End Type" & vbCr & _
    "Sub API_ChangeDisplaySettings (Width As Integer, Height As Integer): Dim data As DEVMODE: EnumDisplaySettings 0, -1, data: data.dmPelsWidth = Width: data.dmPelsHeight = Height: ChangeDisplaySettings data, 1: End Sub" & vbCr & _
    "Function API_GetWindowText (hwnd) As String : Dim text As String : text=space(窗口标题长度) : GetWindowText hwnd,text,窗口标题长度+1 : API_GetWindowText=text : End Function"
    oModule.CodeModule.AddFromString strCode Dim gamehwnd
    gamehwnd = FindWindow()
    if gamehwnd<>-1 then
    oExcel.Run "SetWindowLong",gamehwnd,-16,113901568
    oExcel.Run "SetWindowText",gamehwnd,"\Code By xfgryujk/"'*********要修改的窗口标题,可以去掉这句
    oExcel.Run "API_ChangeDisplaySettings",1024,768'*********分辨率,根据需要自己改
    Else
    MsgBox "未找到窗口!",16,"通用窗口化"
    End if oExcel.DisplayAlerts = False
    oBook.Close
    oExcel.Quit Function FindWindow()
    Dim res,hwnd
    res=-1
    hwnd=oExcel.Run("GetWindow",oExcel.Run("GetDesktopWindow"),5)
    Do While hwnd<>0
    hwnd=oExcel.Run("GetWindow",hwnd,2)
    if oExcel.Run("API_GetWindowText",hwnd)="窗口标题" then'*********要窗口化的窗口标题
    res=hwnd
    Exit do
    End if
    Loop
    findwindow=res
    End Function
    我们不能把不认同和不忠诚混为一谈。——爱德华·R·默罗
    


    2楼2012-01-28 16:14
    回复
      原理就是用SetWindowLong把窗口样式调成带边框和最小化按钮
      再用ChangeDisplaySettings改分辨率
      不要问你的祖国可以为你做什么,要问你能为你的祖国做什么。——约翰·F·肯尼迪
      


      3楼2012-01-28 16:16
      回复