sob790717
|
分享:
▲
▼
下面是引用 ebolaman 於 2010-08-31 19:13 發表的 : 基本上如果不知道附近的程式碼結構,有些簡化程序有時會出問題 例如那個 Text5 ,如果像是化學的催化劑就可以刪除 但如果是在表單上必須用到的就不可刪除
依照僅提供的程式碼 我覺得可以簡化成:
k = CInt(Len(Text2.txt)) If Not (k = 3) Then Goto Err02
If Not (..瓜瓜) 這很好用,假如版本長度要限定在 3~5 可以改成 Not (k >=3 And k <= 5) ,這常常在限制 KeyPress 的 KeyAscii 的數字範圍用到
而後面多了個 Else 我就不清楚是什麼意思了 ELSE後面是要接原本的 ELSE前面就是如果發現到字串長度不合規定時就GOTO到某個標籤 我把這整段做在timer2 這是整個整段程式碼 就可以得知為什要判斷字串長度 複製程式
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
|
|
x0
[2 樓]
From:台灣中華電信 | Posted:2010-09-01 19:52 |
|
|
sob790717
|
分享:
▲
▼
圖 1.
下面是引用 ebolaman 於 2010-09-03 05:03 發表的 :
OK~ 如圖綠色框框 目前搞不定的是如何像圖一樣增加個訊息 網路上有找到一範例 不過寫法太高深 搞不進我的程式中 目前單純增加圖示已經OK了 所以當我要在系統列增加一個圖示時引用GetStar就好了(反之亦然) 只剩下這個提示訊息的部份 以下是我的BAS 複製程式
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
|
|
x0
[6 樓]
From:台灣中華電信 | Posted:2010-09-03 10:25 |
|
|
|