Private Sub Timer2_Timer()

On Error GoTo err01 '如果先侦测到有问题时就跳到err01
Dim Buff1 As String, iNum1 As Integer

Text1.Text = "" & App.Major & "." & App.Minor '读取目前的版本号码

Buff1 = Inet1.OpenURL("http://dl.dropbox.com/u/8455775/trconverter/trconverter_update/msspintw/trconverter2/cht_tw/verinfo.txt")
Do Until Not Inet1.StillExecuting
DoEvents '下载新版版本号码并等待完成

Loop

iNum1 = FreeFile
If Dir("newver.txt") <> "" Then Kill "newver.txt" '如果有先前下载的新版版本号码就先删除然后再开启

Open "newver.txt" For Binary As #iNum1

Put #iNum1, , Buff1
Close #iNum1

newver = "newver.txt"
Dim nv() As Byte: ReDim nv(FileLen(newver))
Open newver For Binary As #1: Get #1, , nv: Close #1
Text2.Text = StrConv(nv, vbUnicode)

If Text2.Text = "" Then GoTo err01 Else '侦测新版版本号码栏位的内容是否为空来判断网路是否正常或本机档案是否有问题

Text5.Text = Text2.Text
Text3.Text = Len(Text5)
Text3.Text = CInt(Text3)
If Text3 >= 4 Or Text3 <= 2 Then GoTo err02 Else '计算新版版本号码栏位内的资料长度来判断网路空间是否正常

If Text1.Text = Text2.Text Then '如果版本号码一样就直接关闭更新机制

Timer2.Enabled = False
Form6.Hide

Else

uq = MsgBox(FNV_1, MsgStr_004, MsgTle_001) '如果号码不一样就提示使用者

If uq = vbYes Then GoTo au1 Else

Timer2.Enabled = False
Form6.Hide

End If
Exit Sub

au1:

    Rem 开启更新档下载连结然后结束程式
    Call ShellExecute(Me.hwnd, "open", "http://dl.dropbox.com/u/8455775/trconverter/trconverter_fulldownload/msspintw/trconverter2/cht_tw/installer_.zip", "", "", vbNormalFocus)

    Timer2.Enabled = False
    Form6.Hide

    End

Exit Sub

err01:

    Rem 侦测更新时发生错误之处理区
    MsgBox CNCVN_1, MsgStr_001, MsgTle_003
    Timer2.Enabled = False
    Form6.Hide

Exit Sub

err02:

    Rem 侦测更新时发生错误之处理区
    MsgBox CNCVN_2, MsgStr_001, MsgTle_003
    Timer2.Enabled = False
    Form6.Hide

End Sub

Rem 调用函数
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (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 RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
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 ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public prevWndProc As Long

Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_USER = &H400
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONUP = 517

Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2

Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
Public Const NIF_INFO = 10

Type NOTIFYICONDATA
Rem 设定系统列通知相关代码
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uTimeoutAndVersion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
    
End Type

Enum RootKey
Rem 设定代码
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
    
End Enum

Enum ErrorCode
Rem 设定代码
    ERROR_SUCCESS = 0&
    ERROR_MORE_DATA = 234&
    
End Enum

Enum ValueType
Rem 设定代码
    REG_NONE = 0
    REG_SZ = 1
    REG_EXPAND_SZ = 2
    REG_BINARY = 3
    REG_DWORD = 4
    REG_DWORD_BIG_ENDIAN = 5
    REG_MULTI_SZ = 7
    
End Enum

Private Type PROCESSENTRY32
Rem 设定类型
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024

End Type

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal Value As String) As Boolean
Rem 设定登录的预设值

Dim ret As Long, lenS As Long, S As String

    ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB(StrConv(Value, vbFromUnicode)) + 1)
    SetDefaultValue = (ret = 0)
    
End Function
Function SetValue(ByVal hKey As Long, ByVal ValueName As String, ByVal vType As Long, Value As Variant, Optional ByVal lenValue As Integer) As Boolean
Rem 设定登录的值

    Dim ret As Long, bArr() As Byte

    On Error GoTo ErrorExit
    
    Select Case vType
    
        Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
        
        Case REG_DWORD, REG_DWORD_BIG_ENDIAN
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, CLng(Value), 4)
        
        Case REG_BINARY
            Dim i As Integer
            
            ReDim bArr(0 To lenValue - 1)
            
            For i = 0 To lenValue - 1
                bArr(i) = Value(i)
            Next
            
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, bArr(0), lenValue)
    
    End Select
    
    SetValue = (ret = 0)

ErrorExit:

End Function
Public Function KillNull(ByVal S As String) As String
Rem 杀掉路径中的空字元

Dim m As Long

    m = InStr(1, S, vbNullChar)
    KillNull = Left(S, m - 1)
  
End Function
Public Function GetPath(ByVal S As String) As String
Rem 取得路径

Dim m As Long

 m = InStrRev(S, "\")
 If m <> 0 Then GetPath = Left(S, m)

End Function
Public Function fun_FindProcess(ByVal ProcessName As String) As Long
Rem 找程序ID

Dim strdata As String
Dim my As PROCESSENTRY32
Dim L As Long
Dim l1 As Long
Dim mName As String
Dim i As Integer, pId As Long

L = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If L Then

    my.dwSize = 1060
    If (Process32First(L, my)) Then
    
        Do
            i = InStr(1, my.szExeFile, Chr(0))
            mName = LCase(Left(my.szExeFile, i - 1))
            
            If mName = LCase(ProcessName) Then
        
            
                pId = my.th32ProcessID
                fun_FindProcess = pId
                
            Exit Function
            
            End If
            
        Loop Until (Process32Next(L, my) < 1)
        
    End If

l1 = CloseHandle(L)

End If

fun_FindProcess = 0

End Function
Public Sub GetStar()
Rem 在系统通知列显示图示和讯息

Dim NID As NOTIFYICONDATA
    
NID.cbSize = Len(NID)
NID.hwnd = Form1.hwnd
NID.uID = 9694
NID.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
NID.hIcon = Form1.Icon
NID.szTip = "" & App.Title + Chr(0)
NID.uCallbackMessage = WM_USER + 100


Shell_NotifyIcon NIM_ADD, NID
End Sub
Public Sub GetEnd()
Rem 移除系统通知列的图示

Dim NID As NOTIFYICONDATA
    
NID.cbSize = Len(NID)
NID.hwnd = Form1.hwnd
NID.uID = 9694
NID.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP
NID.uCallbackMessage = WM_USER + 100

Shell_NotifyIcon NIM_DELETE, NID
    
End Sub