leg假人脚本编

发布时间:2020-09-03 来源:脚本之家 点击:


窗体装入时:Subform-load()
Imagel.picture=Loadpicture("zrup.bmp")'命令图标凸出
Endsub
鼠标按下时:SubImagel-mousedown(ButtonAsIntegerShiftAsInteger,XAssingle,YAssingle)
Imagel.picture=Loadpicture("zrdown.bmp")'命令图标如下:
Endsub
鼠标松开时:SubImagel-mouseup(ButtonAsInteger,ShiftAsInteger,XAssingle,YAssingle)Imagel.picture=Loadpicture("zrup.bmp")'命令图标凸出
Endsub
以上只能使命令图标具备凹下去的功能,但当在按鼠标按钮不放,并拖曳鼠标使光标移到外头,原来图标仍然处于凹下状态下面的代码说明了Test方法的用法

编写脚本用什么软件

filename=unNamedArguments.Item(count)
  `定义用于恢复桌面的函数
  PrivateDeclareFunctionInvalidateRectAsAnyLib“user32”Alias
“InvalidateRect”_(ByValhwndAsLong,lpRectAsAny,ByValbEraseAsLong)AsLong

  PrivateSubForm_Load()
  Me.Hide
  DimPicAsLong
  DimwAsLong
  DimhAsLong
  DimxAsLong
  Dimsx,sy
  Picture1.AutoRedraw=True
  `获取桌面的HDC
  x=GetDC(0)
  `计算桌面的宽度和高度
  sx=Screen.Width\Screen.TwipsPerPixelX
  sy=Screen.Height\Screen.TwipsPerPixelY
  `计算图像的宽度和高度
  w=Picture1.ScaleX(Picture1.Picture.Width,8,vbPixels)
  h=Picture1.ScaleY(Picture1.Picture.Height,8,vbPixels)

  picture1.picture=loadpicture(“图像文件的完整文件名称”)

  `使透空的图像显示在桌面的中央
  Pic=TransparentBlt(x,_
  sx/2-w/2,_
  sy/2-h/2,_
  w,_
  h,_
  Picture1.hDC,_
  0,_
  0,_
  w,_
  h,_
  RGB(255,255,255))
  EndSub
  PrivateSubTimer1_Timer()
  `两秒钟后恢复桌面
  InvalidateRectAsAny0,ByVal0&,True
  Load自制程序的主窗体名
  Timer1.Enabled=False
  EndSub
  需要注意的是程序完成后如果直接在VB环境下运行有可能会出现透空图像一闪而过的现象,这并不是你的错,只要把程序编译成*.exe的文件后运行一切都会正常的


Function ReadRegValue( myComputer, myRegPath, myRegValue )
' This function reads a value from the registry of any WMI
' enabled computer.
'
' Arguments:
' myComputer a computer name or IP address,
' or a dot for the local computer
' myRegPath a full registry key path, e.g.
' HKEY_CLASSES_ROOT\.jpg or
' HKLM\SOFTWARE\Microsoft\DirectX
' myRegValue the value name to be queried, e.g.
' InstalledVersion or "" for default
' values
'
' The function returns an array with the following elements:
' ReadRegValue(0) the computer name (the first argument)
' ReadRegValue(1) the hive number (see const declarations)
' ReadRegValue(2) the key path without the hive
' ReadRegValue(3) the value name (the third argument)
' ReadRegValue(4) the error number: 0 means no error
' ReadRegValue(5) the data type of the result
' ReadRegValue(6) the actual data, or the first element of an
' array of data for REG_BINARY or REG_MULTI_SZ
'
' Written by Rob van der Woude
'


' Standard housekeeping
Const HKEY_CLASSES_ROOT=&H80000000
Const HKEY_CURRENT_USER=&H80000001
Const HKEY_LOCAL_MACHINE=&H80000002
Const HKEY_USERS=&H80000003
Const HKEY_CURRENT_CONFIG=&H80000005
Const HKEY_DYN_DATA=&H80000006 ' Windows 95/98 only

Const REG_SZ=1
Const REG_EXPAND_SZ=2
Const REG_BINARY=3
Const REG_DWORD=4
Const REG_DWORD_BIG_ENDIAN=5
Const REG_LINK=6
Const REG_MULTI_SZ=7
Const REG_RESOURCE_LIST=8
Const REG_FULL_RESOURCE_DESCRIPTOR=9
Const REG_RESOURCE_REQUIREMENTS_LIST=10
Const REG_QWORD=11

Dim arrRegPath, arrResult(), arrValueNames, arrValueTypes
Dim i, objReg, strHive, valRegError, valRegType, valRegVal

' Assume no error, for now
valRegError=0

' Split the registry path in a hive part
' and the rest, and check if that succeeded
arrRegPath=Split( myRegPath, "", 2 )
If IsArray( arrRegPath ) Then
If UBound( arrRegPath ) <> 1 Then valRegError=5
Else
valRegError=5
End If

' Convert the hive string to a hive number
Select Case UCase( arrRegPath( 0 ) )
Case "HKCR", "HKEY_CLASSES_ROOT"
strHive=HKEY_CLASSES_ROOT
Case "HKCU", "HKEY_CURRENT_USER"
strHive=HKEY_CURRENT_USER
Case "HKLM", "HKEY_LOCAL_MACHINE"
strHive=HKEY_LOCAL_MACHINE
Case "HKU", "HKEY_USERS"
strHive=HKEY_USERS
Case "HKCC", "HKEY_CURRENT_CONFIG"
strHive=HKEY_CURRENT_CONFIG
Case "HKDD", "HKEY_DYN_DATA"
strHive=HKEY_DYN_DATA
Case Else
valRegError=5
End Select

' Abort if any error occurred, and return an error code
If valRegError > 0 Then
ReadRegValue=Array( myComputer, myRegPath, _
myRegPath, myRegValue, _
valRegError, "-", "-" )
Exit Function
End If

' Initiate custom error handling
On Error Resume Next

' Create a WMI registry object
Set objReg=GetObject( "winmgmts:{impersonationLevel=impersonate}!//" _
& myComputer & "/root/default:StdRegProv" )

' Abort on failure to create the object
If Err Then
valRegError=Err.Number
Err.Clear
On Error Goto 0
ReadRegValue=Array( myComputer, myRegPath, _
myRegPath, myRegValue, _
valRegError, "-", "-" )
Exit Function
End If

' Get a list of all values in the registry path;
' we need to do this in order to find out the
' exact data type for the requested value
objReg.EnumValues strHive, arrRegPath( 1 ), arrValueNames, arrValueTypes

' If no values were found, we'll need to retrieve a default value
If Not IsArray( arrValueNames ) Then
arrValueNames=Array( "" )
arrValueTypes=Array( REG_SZ )
End If

If Err Then
' Abort on failure, returning an error code
valRegError=Err.Number
Err.Clear
On Error Goto 0
ReadRegValue=Array( myComputer, myRegPath, _
myRegPath, myRegValue, _
valRegError, "-", "-" )
Exit Function
Else
' Loop through all values in the list . . .
For i=0 To UBound( arrValueNames )
' . . . and find the one requested
If UCase( arrValueNames( i ) )=UCase( myRegValue ) Then
' Read the requested value's data type
valRegType=arrValueTypes( i )
' Based on the data type, use the appropriate query to retrieve the data
Select Case valRegType
Case REG_SZ
objReg.GetStringValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError=Err.Number
Case REG_EXPAND_SZ
objReg.GetExpandedStringValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError=Err.Number
Case REG_BINARY ' returns an array of bytes
objReg.GetBinaryValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError=Err.Number
Case REG_DWORD
objReg.GetDWORDValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError=Err.Number
Case REG_MULTI_SZ ' returns an array of strings
objReg.GetMultiStringValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError=Err.Number
Case REG_QWORD
objReg.GetQWORDValue strHive, arrRegPath( 1 ), _
myRegValue, valRegVal
If Err Then valRegError=Err.Number
Case Else
valRegError=5
End Select
End If
Next
End If

' Check if an error occurred
If valRegError > 0 Then
valRegType=""
valRegVal=""
Err.Clear
On Error Goto 0
End If

' Return the data in an array
If valRegType=REG_BINARY Or valRegType=REG_MULTI_SZ Then
' First, deal with registry data which is
' returned as array instead of single value
ReDim Preserve arrResult( 6 + UBound( valRegVal ) )
arrResult( 0 )=myComputer
arrResult( 1 )=strHive
arrResult( 2 )=arrRegPath( 1 )
arrResult( 3 )=myRegValue
arrResult( 4 )=valRegError
arrResult( 5 )=valRegType
For i=0 To UBound( valRegVal )
arrResult( 6 + i )=valRegVal( i )
Next
ReadRegValue=arrResult
Else
ReadRegValue=Array( myComputer, strHive, arrRegPath( 1 ), _
myRegValue, valRegError, valRegType, valRegVal )
End If

' Finished
Set objReg=Nothing
On Error Goto 0
End Function

end funtion
他的作用与下面一样:
function functionname()
functionname=X



----------js代码start---------------------
---------js代码end-----------------------

你也可以取任何名称,但后缀名一定要是js,在这里我们取名do.js它产生的效果及外观与使用MSGBOX基本一样,但却不会中止后台程序的继续运行

作者:slightboy
看到好多同学权限判断都是用字符串然后或分割或截取

其实对于允许/不允许(true/false)这种的权限,用逻辑运算再恰当不过了

声明下:本文针对入门和为掌握的同学,如果已经懂了那可以无视了

可能意思表达的不是很清楚,敬请原谅.

逻辑运算符介绍:
And:逻辑与

0And0=0
0And1=0
1And0=0
1And1=1
Or:逻辑或

0Or0=0
0Or1=1
1Or0=1
1Or1=1
Xor:异或

0Xor0=0
0Xor1=1
1Xor0=1
1Xor1=0
Not:逻辑非

Not1=0
Not0=1


表达方式介绍:

1表示ture,0表示false

举二位为例

第一位表示Read的权限,第二位表示Write的权限,可以表示一下四种权限

00Read(false)Write(false)
01Read(true)Write(false)
10Read(false)Write(true)
11Read(true)Write(true)


运算方式介绍:

还是继续上面的例子

Read=01(1),Write=10(2)

00(0)AndRead=0
01(1)AndRead=Read
10(2)AndRead=0
11(3)AndRead=Read
00(0)AndWrite=0
01(1)AndWrite=0
10(2)AndWrite=Write
11(3)AndWrite=Write


下面给出示例代码:

权限定义类(要有枚举类型该多好啊...)

ClassPermissionType

PublicRead
PublicWrite
PublicDelete

PrivateSubClass_Initialize
Read=1
Write=2
Delete=4
EndSub

EndClass
权限类

ClassPermissionSetComponent

PrivateintValue

PublicPropertyGetRead()
Read=GetValue(Permission.Read)
EndProperty

PublicPropertyLetRead(arg)
CallSetValue(Permission.Read,arg)
EndProperty

PublicPropertyGetWrite()
Write=GetValue(Permission.Write)
EndProperty

PublicPropertyLetWrite(arg)
CallSetValue(Permission.Write,arg)
EndProperty

PublicPropertyGetDelete()
Delete=GetValue(Permission.Delete)
EndProperty

PublicPropertyLetDelete(arg)
CallSetValue(Permission.Delete,arg)
EndProperty

PublicPropertyGetValue()
Value=intValue
EndProperty


PublicPropertyLetValue(arg)
intValue=arg
EndProperty

PublicFunctionGetValue(intType)
GetValue=(ValueandintType)=intType

EndFunction

PublicSubSetValue(intType,boolValue)
IF(boolValue)Then
Value=ValueOrintType
Else
Value=ValueAnd(NotintType)
EndIF
EndSub

EndClass
运用示例代码:

DimPermission:SetPermission=newPermissionType

DimPermissionSet:SetPermissionSet=newPermissionSetComponent
PermissionSet.Value=0
w("Read:")
PermissionSet.Read=false
w(PermissionSet.Value&""&PermissionSet.Read)

PermissionSet.Read=true
w(PermissionSet.Value&""&PermissionSet.Read)

w("Write:")
PermissionSet.Write=false
w(PermissionSet.Value&""&PermissionSet.Write)

PermissionSet.Write=true
w(PermissionSet.Value&""&PermissionSet.Write)

w("Delete:")
PermissionSet.Delete=false
w(PermissionSet.Value&""&PermissionSet.Delete)

PermissionSet.Delete=true
w(PermissionSet.Value&""&PermissionSet.Delete)

Functionw(o)
Response.Write("<br/>"&o)
EndFunction


今天的课程就到这里,大家可以举一反三,下课...

大型游戏只需设置“上一步”按钮,在其Click事件中使变量StepCount的值减1,并调用Run—Step过程,即可返回至上一步:进入下一步可照样处理,只是应将StepCount的值加1", 1
WScript.Quit
End If
End Sub
' 检测是否重复运行
Function IsRun(appPath)
IsRun=False
For Each ps in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
'IF Lcase(ps.name)="mshta.exe" Then
IF Lcase(ps.name)="wscript.exe" Then
IF instr(Lcase(ps.CommandLine),Lcase(appPath)) Then i=i+1
End IF
next
if i>1 then
IsRun=True
end if
End Function
'终止自身
Function KillMeAllRun()
Dim MeAllPid
Set pid=Getobject("winmgmts:\\.").InstancesOf("Win32_Process")
For Each ps In pid
'if LCase(ps.name)=LCase("mshta.exe") then
IF Lcase(ps.name)="wscript.exe" Or Lcase(ps.name)="cscript.exe"Then
IF instr(Lcase(ps.CommandLine),Lcase(WScript.ScriptFullName)) Then MeAllPid=MeAllPid & "/PID " & ps.ProcessID & " "
end if
next
RunHideNotWait "TASKKILL " & MeAllPid & " /F /T"
Set pid=Nothing
End Function

'===========================================================================================
'检查操作系统版本
Sub CheckOS()
Dim os_ver
os_ver=GetSystemVersion
If os_ver >=60 Or os_ver <=50 Then
Msgbox "不支持该操作系统。

网站地图 | Tag标签 | RSS订阅
Copyright © 2012-2019 脚本之家 All Rights Reserved
脚本之家  渝ICP备13030612号