打印本文 打印本文 关闭窗口 关闭窗口
用VB6.0编写自我升级的程序(一)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数1909  更新时间:2009/4/23 15:03:45  文章录入:mintao  责任编辑:mintao
'''' 日期:   2003/12/19

''''

'''' 这里是没有升级时的主程序

''''

'''' ------------------------------------------

 

Private Sub Command1_Click()

  Command1.Enabled = False

   

  '''' 运行更新程序

  Shell App.Path & "\update.exe", vbNormalFocus

 

End Sub

 

Private Sub Form_Load()

  If App.PrevInstance Then End

 

  UpdateIniPath = App.Path & "\Update.ini"

   

  '''' 记录主程序的名字

  WritePrivateProfileString "Main", "Name", App.EXEName, UpdateIniPath

  '''' 记录运行状态

  WritePrivateProfileString "Main", "Active", "-1", UpdateIniPath

  '''' 记录更新次数

  WritePrivateProfileString "Update", "Num", "0", UpdateIniPath

 

  Me.Caption = App.EXEName

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

  '''' 记录运行状态

  WritePrivateProfileString "Main", "Active", "0", UpdateIniPath

End Sub

 

 

用记事本打开modCommon.bas文件,copy以下内容到其中:

 

Attribute VB_Name = "modCommon"

Option Explicit

 

'''' ------------------------------------------

'''' 升级程序的例子

'''' 作者:   谢家峰

'''' 日期:   2003/12/19

''''

'''' 这里是通用模块,放置API函数以及公用函数

''''

'''' ------------------------------------------

 

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds 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 lSize As Long, ByVal lpFilename As String) As Long

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFilename As String) As Long

Public Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFilename As String) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

 

Const WM_Close = &H10

 

Private Const gintMAX_SIZE% = 255                        ''''Maximum buffer size

 

Public UpdateIniPath As String

 

'''' ===============================================

'''' 从资源文件中提取文件

''''

'''' ===============================================

Public Function SaveFileFromRes(vntResourceID As Variant, sType As String, sFileName As String) As Boolean

 

  Dim bytImage() As Byte

  Dim iFileNum As Integer

 

  On Error GoTo SaveFileFromRes_Err

  SaveFileFromRes = True

  bytImage = LoadResData(vntResourceID, sType)

  

  iFileNum = FreeFile

  Open sFileName For Binary As iFileNum

  Put #iFileNum, , bytImage

  Close iFileNum

  Exit Function

 

SaveFileFromRes_Err:

  SaveFileFromRes = False: Exit Function

End Function

 

 

'''' ===============================================

'''' 从缓冲区中读取字符串

''''

'''' ===============================================

Private Function StringFromBuffer(Buffer As String) As String

    Dim nPos As Long

 

    nPos = InStr(Buffer, vbNullChar)

    If nPos > 0 Then

上一页  [1] [2] [3]  下一页

打印本文 打印本文 关闭窗口 关闭窗口