洛阳翼展电脑

批处理写入剪切板

2022-12-6 乱云飞 评论(0) 浏览(172) 标签: 代码 字符串 VB源码 自动输入脚本 复制粘贴

echo http://80c.cc|clip.exe

获取本机IP，并把本机IP写入配置文件

2022-11-14 乱云飞 评论(0) 浏览(177) 标签: VB源码 获取本机IP地址 复制内容到剪切板

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set Shell = WScript.CreateObject("WScript.Shell")
Set IPConfigSet = objWMIService.ExecQuery _
("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to LBound(IPConfig.IPAddress)
strCopy= "http://" & IPConfig.IPAddress(i) & ":8000/onvif/device_service"	'///
rtspip= IPConfig.IPAddress(i)	'///
Call SetClipboardText(strCopy) 		'///
msgbox strCopy,vbOKOnly,"EZsoft"	'///
Next
End If
Next


Sub SetClipboardText(Text)   '写入信息到剪切板
    Dim wsh
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run "mshta vbscript:ClipboardData.SetData("&chr(34)&"text"&chr(34)&"," &Chr(34)& Text &Chr(34)& ")(close)",0,True
    set wsh=Nothing
End Sub


'替换文本：把IP写入onvif.ini配置文件 20221114
set fso = createobject("scripting.filesystemobject")
'读取文件
set stream = fso.opentextfile("onvif.ini",1)
content = stream.readall()
call stream.close()
'替换字符串
content = replace(content,"wwwns.tpddns.cn",rtspip)
'保存文件
set stream = fso.opentextfile("onvif.ini",2)
call stream.write(content)
call stream.close()

VBS写入文本到剪切板

2022-9-22 乱云飞 评论(0) 浏览(156) 标签: VB源码 VB写剪切板

Dim strCopy
strCopy="翼展科技版权所有 http://80c.cc"
Call SetClipboardText(strCopy)

Sub SetClipboardText(Text)   '写入信息到剪切板
    Dim wsh
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run "mshta vbscript:ClipboardData.SetData("&chr(34)&"text"&chr(34)&"," &Chr(34)& Text &Chr(34)& ")(close)",0,True
    set wsh=Nothing
End Sub

VB源码，获取计算机名

2022-9-22 乱云飞 评论(0) 浏览(149) 标签: VB源码 获取计算机名

MsgBox Environ("computername")

----------------------------------------------------------------

Dim a As Object
Set a = CreateObject("Wscript.Network")
Print a.ComputerName
Print a.UserName
Print a.UserDomain

最小化到系统托盘图标

2022-9-20 乱云飞 评论(0) 浏览(170) 标签: VB源码 缩小到系统托盘 最小化到系统托盘

'添加一标准模块，加入以下代码：
Option Explicit
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Const MAX_TOOLTIP As Integer = 64
Const NIF_ICON = &H2
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const NIM_ADD = &H0
Const NIM_DELETE = &H2
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONUP = &H202
Const WM_RBUTTONUP = &H205

Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Private nfIconData As NOTIFYICONDATA

Public Sub TheTray(Fem As Form) '最小化到托盘
nfIconData.hwnd = Fem.hwnd
nfIconData.uID = Fem.Icon '这里确定使用哪个图标
nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
nfIconData.uCallbackMessage = WM_MOUSEMOVE
nfIconData.hIcon = Fem.Icon.Handle
nfIconData.szTip = Fem.Caption & vbNullChar '这里是将鼠标移到图标上时，将显示的文字
nfIconData.cbSize = Len(nfIconData)
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
Fem.Hide
End Sub

Public Sub IconResponse(Fem As Form, X As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_RBUTTONUP '鼠标右键按下
'此处添加弹出菜单语句
Case WM_LBUTTONUP '鼠标左键按下
Fem.WindowState = 0
Fem.Show
Call UnloadIcon
End Select
End Sub

'将图标从托盘中消除
Public Sub UnloadIcon()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub

'--------------------------------------------------------------------------------------
'窗体调用，代码如下：
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call IconResponse(Me, X)
End Sub

Private Sub Form_Resize()
If Me.WindowState = 1 Then
Call TheTray(Me)
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnloadIcon
End Sub
'--------------------------------------------------------------------------------------

一个好玩的小程序

2019-6-19 乱云飞 评论(0) 浏览(8) 标签: VB源码 按键处理 模拟按键 单号录入