维克苗综合站

Private Sub Form_Load()
    Dim resLen As String
    With Inet1
        .Execute "http://www.vicmiao.com/test.rar", "GET"
        Do While .StillExecuting
            DoEvents
        Loop
        resLen = .GetHeader("Content-Length")
    End With

    Debug.Print resLen
End Sub

Private Sub cmdDel_Click()
Dim i As Integer
With List1
    Do While .SelCount > 0
        If .Selected(i) = True Then .RemoveItem (i): i = i – 1
        i = i + 1
    Loop
End With
End Sub

If you set your application’s icon using the built-in facilities of VB, you will find there’s a few things that go wrong. 48×48 icons are not supported; neither are 32-bit colour depth icons. In addition, you can’t provide an application icon which includes multiple colour depths and sizes so it will render correctly regardless of the capabilities of the system on which it is run. This tip demonstrates how to fix the problem by using a resource and a few API calls.

Setting Icons

Windows uses an application’s icon in four different places:

1. Explorer windows
2. The Alt-Tab window
3. On the Taskbar
4. In the TitleBar of the application (if it has a control box).

全文阅读 »

有两种方法，1是注册表方式

模块代码

Option Explicit

Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Public Const REG_SZ = 1

全文阅读 »

关于webbrowser,innet,xmlhttp获取网页源码的比较！

webbrowser：
示例：
For i = 0 To WebBrowser1.Document.All.length – 1
     If WebBrowser1.Document.All(i).tagName = “HTML” Then
        strContent = strContent & WebBrowser1.Document.All(i).innerHTML
        Exit For
      End If
Next

全文阅读 »

VERSION 5.00
Begin VB.Form Form1
Caption         =   “Form1″
ClientHeight    =   5805
ClientLeft      =   120
ClientTop       =   420
ClientWidth     =   8610
LinkTopic       =   “Form1″
ScaleHeight     =   5805
ScaleWidth      =   8610
StartUpPosition =   3  ‘Windows Default
Begin VB.TextBox Text2
Height          =   345
Left            =   3000
TabIndex        =   9
Text            =   “Text2″
Top             =   360
Width           =   2835
End
Begin VB.TextBox Text1
Height          =   345
Left            =   600
TabIndex        =   8
Text            =   “Text1″
Top             =   270
Width           =   1785
End
Begin VB.CommandButton Command2
Caption         =   “Command2″
Height          =   525
Left            =   3720
TabIndex        =   1
Top             =   1140
Width           =   1245
End
Begin VB.CommandButton Command1
Caption         =   “Command1″
Height          =   525
Left            =   2430
TabIndex        =   0
Top             =   1170
Width           =   1245
End
Begin VB.Label Label6
Caption         =   “Label6″
Height          =   795
Left            =   5160
TabIndex        =   7
Top             =   3750
Width           =   2295
End
Begin VB.Label Label5
Caption         =   “Label5″
Height          =   405
Left            =   2640
TabIndex        =   6
Top             =   3750
Width           =   1425
End
Begin VB.Label Label4
Caption         =   “Label4″
Height          =   1125
Left            =   1200
TabIndex        =   5
Top             =   3750
Width           =   2625
End
Begin VB.Label Label3
Caption         =   “Label3″
Height          =   645
Left            =   5820
TabIndex        =   4
Top             =   2580
Width           =   1995
End
Begin VB.Label Label2
Caption         =   “Label2″
Height          =   645
Left            =   3600
TabIndex        =   3
Top             =   2700
Width           =   1635
End
Begin VB.Label Label1
Caption         =   “Label1″
Height          =   465
Left            =   1530
TabIndex        =   2
Top             =   2790
Width           =   1605
End
End
Attribute VB_Name = “Form1″
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib “advapi32.dll” Alias “RegQueryValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib “advapi32.dll” Alias “RegSetValueExA” (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Const error_success = 0&
Const error_baddb = 1009&
Const error_badkey = 1010&
Const error_cantopen = 1011&
Const error_cantread = 1012&
Const error_cantwrite = 1013&
Const error_registry_recovered = 1014&
Const error_registry_corrupt = 1015&
Const error_registry_io_failed = 1016&
Const hkey_classes_root = &H80000000
Const hkey_current_user = &H80000001
Const hkey_local_machine = &H80000002
Const REG_SZ = 1
Const regkey = “softwareMy SoftMy program”
‘接着为各个控件添加代码，代码如下：
Private Sub Command1_Click()
Dim keyvalue As String
Dim retvalue As Long
Dim keyid As Long
retvalue = RegCreateKey(key_local_machine, regkey, keyid)
keyvalue = Text1.Text
retvalue = RegSetValueEx(keyid, “注册名”, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
keyvalue = Text2.Text
retvalue = RegSetValueEx(keyid, “注册公司”, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
If Text1.Text <> “” And Text2.Text <> “” Then
Label3.Caption = Text1.Text
Label5.Caption = Text2.Text
End If
End Sub

Private Sub Command2_Click()
Unload Me
End
End Sub

Private Sub Form_Load()
Dim retvalue As Long
Dim result As Long
Dim keyid As Long
Dim keyvalue As String
Dim subkey As String
Dim bufsize As Long
Label6.Caption = regkey
retvalue = RegCreateKey(hkey_local_machine, regkey, keyid)
If retvalue = 0 Then
subkey = “注册名”
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, 0&, bufsize)
If bufsize < 2 Then
keyvalue = “”
retvalue = RegSetValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
Else
keyvalue = String(bufsize + 1, ” “)
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, bufsize)
keyvalue = Left$(keyvalue, bufsize – 1)
Text1.Text = keyvalue
End If
Label3.Caption = keyvalue

subkey = “注册公司”
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, 0&, bufsize)
If bufsize < 2 Then
keyvalue = “”
retvalue = RegSetValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, Len(keyvalue) + 1)
Else
keyvalue = String(bufsize + 1, ” “)
retvalue = RegQueryValueEx(keyid, subkey, 0&, REG_SZ, ByVal keyvalue, bufsize)
keyvalue = Left$(keyvalue, bufsize – 1)
Text2.Text = keyvalue
End If
Label5.Caption = keyvalue
End If
End Sub

‘我测试时用到SSTab 控件，会有bug

Option Explicit
Private FormOldWidth As Long
‘保存窗体的原始宽度
Private FormOldHeight As Long
‘保存窗体的原始高度

‘在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
    Dim Obj As Control
    FormOldWidth = FormName.ScaleWidth
    FormOldHeight = FormName.ScaleHeight
    On Error Resume Next
    For Each Obj In FormName
    Obj.Tag = Obj.Left & ” ” & Obj.Top & ” ” & Obj.Width & ” ” & Obj.Height & ” “
    Next Obj
    On Error GoTo 0
End Sub

全文阅读 »

Option Explicit
Dim f() As Form1
Dim i As Integer

Private Sub MDIForm_Load()
i = 0
End Sub

Private Sub mnu_1_Click()
ReDim Preserve f(i)
Set f(i) = New Form1
f(i).Caption = “hello”
f(i).Show
i = i + 1
End Sub

Private Sub mnu_2_Click()
    f(i – 1).Hide
    Set f(i – 1) = Nothing
    i = i – 1
End Sub

Option Explicit
Dim WithEvents M_Dom       As MSHTML.HTMLDocument
Private Sub Form_Load()
    Me.WebBrowser1.Navigate (App.Path & "/sad.html")
End Sub

Private Function M_Dom_oncontextmenu() As Boolean
    M_Dom_oncontextmenu = False
End Function

Private Sub Webbrowser1_DownloadComplete()
    Set M_Dom = WebBrowser1.Document
End Sub