巫妖天下 - LichSky

[CODE_LITE]
'ty 是一个textBox ,默认值是 30

Private Sub Command1_Click()
Dim t, L
Dim i, Tt, Ll

t = Me.Top
L = Me.Left

For i = 1 To 200 ' 这个200 可以控制抖动的次数
Tt = Rnd(1) * ty - ty / 2
Ll = Rnd(1) * ty - ty / 2
Me.Top = Me.Top + Tt
...

[CODE_LITE]
Sub downFile(url As String)
Dim bytes() As Byte
'把文件的字节读到一个Byte数组中
bytes() = Inet1.OpenURL(url, icByteArray)

Open "c:\mp3.mp3" For Binary Acc

[CODE_LITE]
Private Sub Command1_Click()

Text2.Text = CodeToUni(Text1.Text)

End Sub


Private Sub Command2_Click()

Text1.Text = UniToCode(Text2.Text)

End Sub


'-----------------字符Unicode编码与反编码----------------------
Function CodeToUni(code)
...

[CODE_LITE]
Private Sub Command1_Click()
Text1.Text = Text1.Text & Clipboard.GetText
End Sub


Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyV And Shift = vbCtrlMask Then
MsgBox "请右键粘贴", , "警告"
KeyCode = 0
...

[CODE_LITE]
Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
'以下代码可以建立多级文件夹:
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
...

[CODE_LITE]
Option Explicit
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
...

[CODE_LITE]
'=========================
'URLEncode Utf-8 版
'=========================
Function GBtoUTF8(szInput)

Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3

'如果输入参数为空，则退出函数
If szInput = "" Then
GBtoUTF8 = szInput
...

[CODE_LITE]

'====================================
'放一个按钮、两个text、一个Inet
'====================================
Private Sub Command1_Click()
Command1.Enabled = False

Inet1.RequestTimeout = 5 '过期时间设置

On Error GoTo ErrProc:
Text2.Text = Inet1.OpenURL(Text1.Text)
...

[CODE_LITE]
' ============================================
' 去除html格式的,过滤文章,只显示文字
' 引入 Microsoft VBScript Regular Expressions 5.5
' ============================================
Function RemoveHTML(strHTML)
Dim objRegExp, Match, Matches
Set objRegExp = New Regexp
...