用VB帮星河霸业游戏团队的《第二天堂》游戏写的一个在线更新程序， 自动判断是否需要更新，支持多文件更新，并支持.zip压缩文件更新，自动将.zip压缩文件解压到目录下。 源代码下载：VB_OnlineUpdateInet.rar 其中：ClientInfor.inf 文件：                                            第一行的数据表示： 客户端游戏版本号                                            第一行的数据表示： 更新文件存放的网络路径            UpdateInfor.inf文件：                                            第一行的数据表示： 最新游戏版本号                                            第二行的数据表示： 有多少文件需要更新                                            后面每行的数据表示： 需要更新的文件的名称            frmUpdate.frm窗体： 负责下载            modZip.BAS模块： 只负责用来压缩文件和解压缩文件的                                                其中的 UnZipTo  函数用来解压缩的            zlib.dll： 为WinZip的dll文件            更新完毕后，ClientInfor.inf文件的第一行的数据会变为最新版本号   frmUpdate.frm窗体代码如下： Private Sub cmdExit_Click()    Unload Me    End Sub Private Sub cmdUpdate_Click()    Dim strClientInfor() As String    Dim strUpdateInfor() As String    Dim nNum As Integer  ' 存储更新到第几个文件 ' 出错则跳出更新，并提示给用户On Error GoTo ErrMsg     strClientInfor() = getClientInfor    strUpdateInfor() = getUpdateInfor(strClientInfor(1))        inetOLUpdate.RequestTimeout = 0     ' 以验证客户可以连接到服务器,后面更新将不在设置请求超时    nNum = 0        Dim verClient As Double    Dim verUpdate As Double    Dim strName   As Variant    Dim bArray()  As Byte    Dim nI        As Integer    Dim strFlag   As String     ' 保存后缀名     verClient = strClientInfor(0)   ' 获得客户端游戏版本号    verUpdate = strUpdateInfor(0)   ' 获得最新游戏版本号        If verClient < verUpdate Then   ' 判断客户端游戏版本是否是最新版            If MsgBox("已出最新版，是否更新游戏", vbInformation + vbYesNo, "在线更新") = vbYes Then                        ' 设置进度条            timUpdate.Enabled = True            proUpdate.Max = CInt(strUpdateInfor(1))            proUpdate.Min = 0                        ' 更新游戏            For nI = 2 To CInt(strUpdateInfor(1)) + 1                            ' 显示正在更新第几个文件,以及更新文件总数                lblNumber.Caption = "文件更新(" & (nI - 1) & "/" & CInt(strUpdateInfor(1)) & ")"                                ' 读取服务器更新文件，并保存到客户端                bArray() = inetOLUpdate.OpenURL(strClientInfor(1) + "/" + strUpdateInfor(nI), icByteArray)                Open App.Path + "\" + strUpdateInfor(nI) For Binary Access Write As #1                Put #1, , bArray()                Close #1                                nNum = nI - 1   ' 存储更新到第几个文件                                proUpdate.Value = nNum  ' 更新进度条                    lblScale.Caption = (proUpdate.Value / proUpdate.Max) * 100 & "%"        ' 显示更新比例                            Next nI                        ' 减压.zip文件            For nI = 2 To CInt(strUpdateInfor(1)) + 1                strFlag = Mid(strUpdateInfor(nI), InStr(strUpdateInfor(nI), ".") + 1) ' 获得后缀名                                If strFlag = "zip" Then     ' 判断该文件是否为.zip压缩文件                    UnZipTo App.Path, App.Path + "\" + strUpdateInfor(nI)   ' 解压缩                    Kill App.Path + "\" + strUpdateInfor(nI)    ' 删除压缩文件                End If                        Next nI                        ' 更新客户端信息文件 UpdateInfor.inf            updateClientInfor strUpdateInfor(0), strClientInfor(1)                        MsgBox "游戏更新完毕，谢谢你的支持！", vbInformation + vbOKOnly, "在线更新"                        Unload Me   ' 结束在线更新                    End If            Else        MsgBox "已是最新版,不需要更新!", vbInformation + vbOKOnly        Unload Me   ' 结束在线更新            End If        Exit Sub    ErrMsg:    MsgBox "游戏更新出错，请重新启动游戏更新", vbCritical + vbOKOnly, "在线更新"    End Sub Private Sub Form_Load()     inetOLUpdate.RequestTimeout = 15     ' 请求连接超过15秒,则退出连接 End Sub   ' 获得客户端游戏版本号和服务器路径信息Public Function getClientInfor() As Variant    Dim strInfor(10)  As String    Dim strTest       As String    Dim nI            As Integer        nI = 0    Open App.Path + "/ClientInfor.inf" For Input As #1   ' 打开ClientInfor.inf        Do While Not EOF(1)  ' 获得客户端的 游戏版本 和 服务器路径  信息        Line Input #1, strInfor(nI)        nI = nI + 1    Loop        Close #1        getClientInfor = strInfor()    End Function ' 获得更新文件信息' strPath 为更新文件在网上的地址Public Function getUpdateInfor(strPath As String) As Variant    Dim strInfor(20)  As String    Dim nI            As Integer    Dim bArray()      As Byte        ' 读取服务器更新文件的信息，并保存到客户端    bArray() = inetOLUpdate.OpenURL(strPath + "/UpdateInfor.inf", icByteArray)    'Kill "UpdateInfor.inf"      ' 删除原有更新文件    Open App.Path + "/UpdateInfor.inf" For Binary Access Write As #1    Put #1, , bArray()    Close #1        nI = 0    Open App.Path + "/UpdateInfor.inf" For Input As #1   ' 打开ServerInfor.inf        Do While Not EOF(1)   ' 获得最新的 游戏版本 和 更新文件的路径        Line Input #1, strInfor(nI)        nI = nI + 1    Loop        Close #1        getUpdateInfor = strInfor()    End Function ' 更新客户端信息文件 UpdateInfor.infPublic Function updateClientInfor(strVersion As String, strWebPath As String) As Boolean    Open App.Path + "/ClientInfor.inf" For Output As #1        Print #1, strVersion    Print #1, strWebPath        Close #1    End Function   modZip.BAS模块代码如下： 只负责用来压缩文件和解压缩文件的(可以不看)                                                       其中的 UnZipTo  函数用来解压缩的 Option Explicit'-------------------------------------------------------------------------------------------'This module use zlib.dll to unzip any .zip file to a path'eg: UnZipTo "c:\1.zip","c:\1"''by:PANBing'2006.5.18'------------------------------------------------------------------------------------------- 'tm_unz contain date/time infoPrivate Type tm_unz    tm_sec As Long             'seconds after the minute - [0,59]    tm_min As Long             'minutes after the hour - [0,59]    tm_hour As Long            'hours since midnight - [0,23]    tm_mday As Long            'day of the month - [1,31]    tm_mon As Long             'months since January - [0,11]    tm_year As Long            'years - [1980..2044]End Type '  unz_global_info structure contain global data about the ZIPfile'  These data comes from the end of central dirPrivate Type unz_global_info    number_entry As Long        'total number of entries in                                'the central dir on this disk    size_comment As Long        'size of the global comment of the zipfileEnd Type ' unz_file_info contain information about a file in the zipfile */Private Type unz_file_info    version As Long                 'version made by                 2 bytes    version_needed As Long          'version needed to extract       2 bytes    flag As Long                    'general purpose bit flag        2 bytes    compression_method As Long      'compression method              2 bytes    dosDate As Long                 'last mod file date in Dos fmt   4 bytes    crc As Long                     'crc-32                          4 bytes    compressed_size As Long         'compressed size                 4 bytes    uncompressed_size As Long       'uncompressed size               4 bytes    size_filename As Long           'filename length                 2 bytes    size_file_extra As Long         'extra field length              2 bytes    size_file_comment As Long       'file comment length             2 bytes     disk_num_start As Long          'disk number start               2 bytes    internal_fa As Long             'internal file attributes        2 bytes    external_fa As Long             'external file attributes        4 bytes     tmu_date As tm_unzEnd Type 'public Declare Function Compress Lib "ZLIB.DLL" Alias "compress2" (ByRef DestinationArray As Byte, ByRef DestLen As Long, ByRef SourceArray As Byte, ByVal SourceLen As Long, ByVal CompressionLevel As Long) As Long '  Open a Zip file. path contain the full pathname (by example,'     on a Windows XP computer "c:\\zlib\\zlib113.zip" or on an Unix computer'     "zlib/zlib113.zip".'     If the zipfile cannot be opened (file don't exist or in not valid), the'       return value is NULL.'     Else, the return value is a unzFile Handle, usable with other function'       of this unzip package.Private Declare Function unzOpen Lib "ZLIB.DLL" (ByVal FilePath As String) As Long 'Close a ZipFile opened with unzipOpen.'If there is files inside the .Zip opened with unzOpenCurrentFile (see later),'  these files MUST be closed with unzipCloseCurrentFile before call unzipClose.'return UNZ_OK if there is no problem. */Private Declare Function unzClose Lib "ZLIB.DLL" (ByVal hFile As Long) As Long '  Write info about the ZipFile in the *pglobal_info structure.'  No preparation of the structure is needed'  return UNZ_OK if there is no problem.Private Declare Function unzGetGlobalInfo Lib "ZLIB.DLL" (ByVal hFile As Long, ByRef pglobal_info As unz_global_info) As Long '  Get Info about the current file'  if pfile_info!=NULL, the *pfile_info structure will contain somes info about'        the current file'  if szFileName!=NULL, the filemane string will be copied in szFileName'            (fileNameBufferSize is the size of the buffer)'  if extraField!=NULL, the extra field information will be copied in extraField'            (extraFieldBufferSize is the size of the buffer).'            This is the Central-header version of the extra field'  if szComment!=NULL, the comment string of the file will be copied in szComment'            (commentBufferSize is the size of the buffer)Private Declare Function unzGetCurrentFileInfo Lib "ZLIB.DLL" (ByVal hFile As Long, _                         ByRef pfile_info As unz_file_info, _                         ByVal szFileName As String, _                         ByVal fileNameBufferSize As Long, _                         ByRef extraField As Long, _                         ByVal extraFieldBufferSize As Long, _                         ByVal szComment As String, _                         ByVal commentBufferSize As String) As Long ' for reading the content of the current zipfile, you can open it, read data' from it, and close it (you can close it before reading all the file)''  Open for reading data the current file in the zipfile.'  If there is no error, the return value is UNZ_OK.Private Declare Function unzOpenCurrentFile Lib "ZLIB.DLL" (ByVal hFile As Long) As Long 'Close the file in zip opened with unzOpenCurrentFile'Return UNZ_CRCERROR if all the file was read but the CRC is not goodPrivate Declare Function unzCloseCurrentFile Lib "ZLIB.DLL" (ByVal hFile As Long) As Long                                        'Read bytes from the current file (opened by unzOpenCurrentFile)'buf contain buffer where data must be copied'len the size of buf.'return the number of byte copied if somes bytes are copied'return 0 if the end of file was reached'return <0 with error code if there is an error'(UNZ_ERRNO for IO error, or zLib error for uncompress error)Private Declare Function unzReadCurrentFile Lib "ZLIB.DLL" (ByVal hFile As Long, _                      ByRef Buffer As Byte, _                      ByVal BuffLen As Long) As Long 'Set the current file of the zipfile to the next file.'return UNZ_OK if there is no problem'return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest.Private Declare Function unzGoToNextFile Lib "ZLIB.DLL" (ByVal hFile As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongPrivate Type SECURITY_ATTRIBUTES        nLength As Long        lpSecurityDescriptor As Long        bInheritHandle As LongEnd Type Private Const BUFFERSIZE        As Long = 2048Private Const MAX_PATH          As Long = 260Private Const MAX_COMMENT       As Long = 255Private strFileNameBuff         As String * MAX_PATHPrivate szComment               As String * MAX_COMMENTPrivate hFile                   As LongPrivate buff()                  As Byte Public Sub UnZipTo(ByVal strPath As String, ByVal strZipFile As String)Dim strFileName             As StringDim tPath                   As StringDim info                    As unz_file_infoDim i                       As LongReDim buff(BUFFERSIZE - 1) As Byte hFile = unzOpen(strZipFile)If hFile = 0 Then Exit Sub strPath = Replace(strPath & "\", "\\", "\")If Dir(strPath, vbDirectory) = "" Then Call CreateFloder(strPath) Do    i = unzGetCurrentFileInfo(hFile, info, strFileNameBuff, MAX_PATH, 0, 0, szComment, MAX_COMMENT)        strFileName = Left(strFileNameBuff, info.size_filename)    tPath = strPath    If InStr(strFileName, "/") > 0 Then        strFileName = Replace(strFileName, "/", "\")        tPath = CreateFloder(GetPath(strPath & strFileName))        strFileName = GetFileName(strFileName)    End If        i = unzOpenCurrentFile(hFile)            If (info.external_fa And &H10) = 0 Then        Open tPath & strFileName For Binary As #1        Do            i = unzReadCurrentFile(hFile, buff(0), BUFFERSIZE)            If i = 0 Then Exit Do            If i < BUFFERSIZE Then                ReDim tbuff(i - 1) As Byte                Call CopyMemory(tbuff(0), buff(0), i)                Put #1, , tbuff            Else                Put #1, , buff            End If        Loop Until (i < BUFFERSIZE)        Close #1    End If    Loop Until (unzGoToNextFile(hFile) <> 0)i = unzCloseCurrentFile(hFile)i = unzClose(hFile)End Sub Private Function CreateFloder(ByVal strPath As String) As StringDim tmpPath As StringDim t       As SECURITY_ATTRIBUTESDim i       As LongDim Index   As IntegerstrPath = Replace(strPath & "\", "\\", "\")Do    Index = InStr(Index + 1, strPath, "\")    tmpPath = Left(strPath, Index)        If Dir(tmpPath, vbDirectory) = "" Then        i = CreateDirectory(tmpPath, t)    End If Loop Until (Dir(strPath, vbDirectory) <> "")CreateFloder = strPathEnd Function Private Function GetFileName(ByVal strPath As String) As StringDim i As Integer 'For i = Len(strPath) To 1 Step -1'    If Mid(strPath, i, 1) = "\" Then        i = InStrRev(strPath, "\")                GetFileName = Right(strPath, Len(strPath) - i)'        Exit Function'    End If'Next iEnd Function Private Function GetPath(ByVal strPath As String) As StringDim i As Integer 'For i = Len(strPath) To 1 Step -1'    If Mid(strPath, i, 1) = "\" Then        i = InStrRev(strPath, "\")        GetPath = Left(strPath, i)'        Exit Function'    End If'Next iEnd Function  

评论