frmclient.frm

用于局域网中的文件自动更新下载

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmClient 
   Caption         =   "Client"
   ClientHeight    =   2700
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7095
   LinkTopic       =   "Form1"
   ScaleHeight     =   2700
   ScaleWidth      =   7095
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer timerDownloadFinished 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   3480
      Top             =   4080
   End
   Begin MSWinsockLib.Winsock sckDatabaseUpdate 
      Left            =   4320
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckFilesUpdate 
      Left            =   6000
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckClientCommunication 
      Left            =   5160
      Top             =   4080
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Connect"
      Height          =   495
      Left            =   2940
      TabIndex        =   2
      Top             =   1680
      Width           =   1215
   End
   Begin VB.TextBox txtEventId 
      Height          =   495
      Left            =   1980
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   360
      Width           =   4575
   End
   Begin VB.Label Label7 
      Caption         =   "XmlMessage"
      Height          =   495
      Left            =   540
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private sUpdateFileName As String
Private bNewFile        As Boolean
Private bSaveFinished   As Boolean
Private colFilesInfo    As Collection


Private Sub Command1_Click()
    ' establish the connect
    With sckClientCommunication

        If .State <> sckConnected Then
            .Close

            Do While .State <> sckClosed
                DoEvents
            Loop

            .Connect
    
            Do While .State <> sckConnected
                DoEvents
            Loop
        End If
        ' send the command
        .SendData SendCommand(COMMAND_GETUPDATEFILE)
    End With
End Sub

Private Sub Form_Load()
    Init.Init
   
    With sckClientCommunication
        .RemoteHost = objServerInfo.sServerAddress
        .RemotePort = objServerInfo.sCommunicationPort
    End With
    
    With sckFilesUpdate
        .RemoteHost = objServerInfo.sServerAddress
        .RemotePort = objServerInfo.sHttpServerPort
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    timerDownloadFinished.Interval = 0

    sckClientCommunication.Close
    Do While sckClientCommunication.State <> sckClosed
        DoEvents
    Loop
    
    sckFilesUpdate.Close
    Do While sckFilesUpdate.State <> sckClosed
        DoEvents
    Loop
    
    Unload Me
    
    End
End Sub

Private Sub sckClientCommunication_DataArrival(ByVal bytesTotal As Long)

    Dim sData             As String
    Dim colUpdateFileInfo As Collection

    sckClientCommunication.GetData sData, vbString
    txtEventId.Text = sData

    If Dir(objSystemInfo.sAppPath & UPDATE_FOLDER, vbDirectory) = "" Then
        MkDir objSystemInfo.sAppPath & UPDATE_FOLDER
    End If

    Set colUpdateFileInfo = GetUpdateFile(GetLocalFileInfo(objSystemInfo.sAppPath & _
            UPDATE_FOLDER), GetRemoteFileInfo(sData))
    'frmDownload.Timer1.Enabled = True
    timerDownloadFinished.Enabled = True
    'frmDownload.SaveFiles colUpdateFileInfo
    SaveFiles colUpdateFileInfo
End Sub

Private Sub sckFilesUpdate_DataArrival(ByVal bytesTotal As Long)
    Dim byteByteData()      As Byte          ' received data
    Dim byteTotalByteData() As Byte     ' All of the received data
    Dim sByteData           As String
    Dim iLengthStartPos     As Integer      ' start position of the label "Content-Length"
    Dim iLengthEndPos       As Integer        ' end position of the label "Content-Length"

    Static lAllBytesTotal   As Long       ' all received data's length

    Static sLength          As String

    Dim iFileNum            As Long               ' filenumber
    Dim iIndex              As Long

    If sLength = "" Then
        sLength = "0"
    End If

    If Dir(objSystemInfo.sAppPath & BACKUP_FOLDER, vbDirectory) = "" Then
        MkDir objSystemInfo.sAppPath & BACKUP_FOLDER
    End If

    If Dir(objSystemInfo.sAppPath & UPDATE_FOLDER, vbDirectory) = "" Then
        MkDir objSystemInfo.sAppPath & UPDATE_FOLDER
    End If

    If bNewFile Then
        lAllBytesTotal = bytesTotal
        bNewFile = False
    Else
        lAllBytesTotal = bytesTotal + lAllBytesTotal
    End If

    ' check the connection's status
    Do While sckFilesUpdate.BytesReceived = 0

        If sckFilesUpdate.State = sckClosed Then Exit Sub

        DoEvents
    Loop

    ' get the block data
    sckFilesUpdate.GetData byteByteData, vbByte
    ' change the byte to string to find the filesize by label "Content-Length"
    sByteData = StrConv(byteByteData, vbUnicode)
    ' get start position of the label "Content-Length"
    iLengthStartPos = InStr(1, sByteData, "Content-Length:")

    ' if find the label then get the end position to get the filesize
    If iLengthStartPos > 0 Then
        iLengthEndPos = InStr(iLengthStartPos, sByteData, vbCrLf)
        ' save filesize
        sLength = Mid(sByteData, iLengthStartPos + Len("Content-Length: "), _
                iLengthEndPos - (iLengthStartPos + Len("Content-Length: ")))
    End If

    iFileNum = FreeFile()
    ' save each block data to the temp file
    Open objSystemInfo.sAppPath & TEMP_FILE_NAME For Binary As #iFileNum

    For iIndex = 0 To bytesTotal - 1
        Put #iFileNum, LOF(iFileNum) + 1, byteByteData(iIndex)
    Next iIndex

    Close #iFileNum

    'if filesize bigger than the received data's length
    If sLength < lAllBytesTotal Then
        Open objSystemInfo.sAppPath & TEMP_FILE_NAME For Binary Access Read As #iFileNum
        ReDim byteTotalByteData(LOF(1) - 1) As Byte
        Get #1, 1, byteTotalByteData
        Close #iFileNum
        
        ' delete the file if exist,
        If Dir(objSystemInfo.sAppPath & UPDATE_FOLDER & "\" & sUpdateFileName) <> "" _
                Then Kill objSystemInfo.sAppPath & UPDATE_FOLDER & "\" & _
                sUpdateFileName
        Open objSystemInfo.sAppPath & UPDATE_FOLDER & "\" & sUpdateFileName For _
                Binary As #iFileNum

        For iIndex = lAllBytesTotal - CLng(sLength) To UBound( _
                byteTotalByteData())
            Put #iFileNum, LOF(iFileNum) + 1, byteTotalByteData(iIndex)
        Next iIndex

        Close #iFileNum

        ' clean the temp file
        If Dir(objSystemInfo.sAppPath & TEMP_FILE_NAME) <> "" Then Kill objSystemInfo.sAppPath & _
            TEMP_FILE_NAME
        'MsgBox "download finished!"
        bSaveFinished = True
    End If
End Sub

Private Sub timerDownloadFinished_Timer()
    If bSaveFinished Then
        Enter
    End If
End Sub

Private Sub Enter()

    Dim objFileInfo   As FILEINFO
    Dim sCommand      As String

    Static iFileNo    As Integer
    Static iFileCount As Integer

    iFileCount = colFilesInfo.Count
    iFileNo = iFileNo + 1
    If Dir(App.Path & "\" & TEMP_FILE_NAME) <> "" Then Kill App.Path & "\" & _
            TEMP_FILE_NAME

    If iFileNo > iFileCount Then
        timerDownloadFinished.Enabled = False

        iFileNo = 0
        MsgBox "Update Finished"

        Exit Sub

    End If

    sUpdateFileName = colFilesInfo(iFileNo).sFileName

    If sUpdateFileName = "" Then
        MsgBox "please input the file name what you want"
        Exit Sub
    End If

    sCommand = "GET /" & sUpdateFileName & " HTTP/1.1" & vbCrLf
    sCommand = sCommand & "Host: " & objServerInfo.sServerAddress & vbCrLf
    sCommand = sCommand & "Accept: */*" & vbCrLf
    sCommand = sCommand & "Referer: http://" & objServerInfo.sServerAddress & _
            vbCrLf
    sCommand = sCommand & _
            "User-Agent: Mozilla/4.0 (compatible; MSIE 5.00; Windows 98)" & _
            vbCrLf
    sCommand = sCommand & "Pragma: no-cache" & vbCrLf
    sCommand = sCommand & "Cache-Control: no-cache" & vbCrLf
    sCommand = sCommand & "Connection: close" & vbCrLf
    sCommand = sCommand & vbCrLf
    Debug.Print sCommand
    bNewFile = True
    
    With sckFilesUpdate
        If .State <> sckConnected Then
            .Close
            .Connect
        End If
    
        Do While .State <> sckConnected
            DoEvents
        Loop
    
        .SendData sCommand
    End With
End Sub

Private Sub SaveFiles(ByVal colUpdateFileInfo As Collection)
    Set colFilesInfo = colUpdateFileInfo
    Enter
End Sub