www.pudn.com > AutoUpdate.rar > CommonFunction.bas
Attribute VB_Name = "CommonFunction"
Option Explicit
' dom object
Private objDomDocument As DOMDocument
''''''''''''''''''''''''''''''''''''
'' send the command
''''''''''''''''''''''''''''''''''''
Public Function SendCommand(ByVal sXmlCommand As String) As String
Dim objCommandElement As IXMLDOMElement
Dim objRootElement As IXMLDOMElement
' Init dom object
Set objDomDocument = New DOMDocument
' create the root element
Set objRootElement = objDomDocument.createElement(COMMANDS_TAG)
' create the command to get the new update files
Set objCommandElement = CreateNode(objRootElement, COMMAND_TAG, _
sXmlCommand)
' add to the dom object
objDomDocument.appendChild objRootElement
SendCommand = objDomDocument.xml
Set objRootElement = Nothing
Set objCommandElement = Nothing
Set objDomDocument = Nothing
End Function
''''''''''''''''''''''''''''''''''''
'' get the command from dom object
''''''''''''''''''''''''''''''''''''
Public Function GetCommand(ByVal sXmlCommand As String) As String
Dim objRootElement As IXMLDOMElement
Dim sCommand As String
' init the dom object
Set objDomDocument = New DOMDocument
' load the xml command
objDomDocument.loadXML sXmlCommand
' get the root element
Set objRootElement = GetRootNode(objDomDocument, COMMANDS_TAG)
' get command string
sCommand = GetNodeValue(objRootElement, COMMAND_TAG)
' return the command
GetCommand = sCommand
' release the variable
Set objRootElement = Nothing
Set objDomDocument = Nothing
End Function
''''''''''''''''''''''''''''''''''''
'' Add a new node to the indicated objParentNode node.
''''''''''''''''''''''''''''''''''''
Private Function CreateNode(ByVal objParentNode As IXMLDOMNode, _
ByVal sNodeName As String, _
Optional sNodeValue As String = "") As IXMLDOMNode
Dim objNewNode As IXMLDOMNode
' Create the new node.
Set objNewNode = objParentNode.ownerDocument.createElement(sNodeName)
' Set the node's text value.
If sNodeValue <> "" Then
objNewNode.Text = sNodeValue
End If
' Add the node to the objParentNode.
objParentNode.appendChild objNewNode
Set CreateNode = objNewNode
' release the variable
Set objParentNode = Nothing
Set objNewNode = Nothing
End Function
''''''''''''''''''''''''''''''''''''
'' Return the root node element
''''''''''''''''''''''''''''''''''''
Private Function GetRootNode(ByVal objDomDocument As DOMDocument, _
ByVal sRootNodeName As String) As IXMLDOMNode
Dim objRootNode As IXMLDOMNode
' get the root node element by node name
Set objRootNode = objDomDocument.selectSingleNode(".//" & sRootNodeName)
If Not objRootNode Is Nothing Then
Set GetRootNode = objRootNode
End If
' release the variable
Set objRootNode = Nothing
End Function
''''''''''''''''''''''''''''''''''''
'' Return the node value. Only for single node
''''''''''''''''''''''''''''''''''''
Private Function GetNodeValue(ByVal objStartAtNode As IXMLDOMNode, _
ByVal sNodeName As String) As String
Dim objValueNode As IXMLDOMNode
' get the node value by node name
Set objValueNode = objStartAtNode.selectSingleNode(".//" & sNodeName)
If Not objValueNode Is Nothing Then
GetNodeValue = objValueNode.Text
End If
' release the variable
Set objValueNode = Nothing
End Function
''''''''''''''''''''''''''''''''''''
'' Return the node list
''''''''''''''''''''''''''''''''''''
Private Function GetNodes(ByVal objNode As IXMLDOMNode, _
ByVal sNodeName As String) As IXMLDOMNodeList
Dim objNodeList As IXMLDOMNodeList
' get the node list by node name
Set objNodeList = objNode.selectNodes(".//" & sNodeName)
' return the node list
Set GetNodes = objNodeList
' release the variable
Set objNodeList = Nothing
End Function
' Get the files' infomation
Public Function GetLocalFileInfo(ByVal sPath As String) As Collection
Dim objFso As Scripting.FileSystemObject
Dim objFolder As Folder
'Dim objSubFolder As Folder
Dim objFile As File
Dim objFileInfo As FILEINFO
Dim colFileInfo As Collection
If sPath = "" Then sPath = objSystemInfo.sAppPath
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
Set colFileInfo = New Collection
Set objFso = New Scripting.FileSystemObject
Set objFolder = objFso.GetFolder(sPath)
For Each objFile In objFolder.Files
Set objFileInfo = New FILEINFO
objFileInfo.sFileName = objFile.Name
objFileInfo.sFileSize = objFile.Size
objFileInfo.sModifiedDate = objFile.DateLastModified
colFileInfo.Add objFileInfo
Next
' sub folder
' If objFolder.SubFolders.Count > 0 Then
' For Each sfd In obFd.SubFolders
' Call getFilenm(sfd.Path)
' Next
' End If
Set GetLocalFileInfo = colFileInfo
Set objFileInfo = Nothing
Set colFileInfo = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFso = Nothing
End Function
Public Function GetRemoteFileInfo(ByVal sUpdateInfo As String) As Collection
' the child elements' list
Dim colNodeList As IXMLDOMNodeList
' root element
Dim objRootElement As IXMLDOMElement
' child element
Dim objChildElement As IXMLDOMElement
Dim objFileInfo As FILEINFO
Dim colFileInfo As Collection
' init the file info
Set colFileInfo = New Collection
Set objDomDocument = New DOMDocument
objDomDocument.loadXML sUpdateInfo
Set objRootElement = GetRootNode(objDomDocument, FILE_ROOT_ELEMENT)
Set colNodeList = GetNodes(objRootElement, FILE_ELEMENT)
If Not colNodeList Is Nothing Then
For Each objChildElement In colNodeList
Set objFileInfo = New FILEINFO
objFileInfo.sFileName = GetNodeValue(objChildElement, FILENAME_ELEMENT)
objFileInfo.sModifiedDate = GetNodeValue(objChildElement, _
MODIFIEDDATE_ELEMENT)
objFileInfo.sFileSize = GetNodeValue(objChildElement, FILESIZE_ELEMENT)
' add the file info to the collection
colFileInfo.Add objFileInfo
Next
End If
Set GetRemoteFileInfo = colFileInfo
Set objDomDocument = Nothing
Set colNodeList = Nothing
Set objRootElement = Nothing
Set objChildElement = Nothing
Set objFileInfo = Nothing
Set colFileInfo = Nothing
End Function
Public Function GetUpdateFile(colLocalFileInfo As Collection, _
colRemoteFileInfo As Collection) As Collection
Dim objLocalFileInfo As FILEINFO
Dim objRemoteFileInfo As FILEINFO
Dim colUpdateFile As Collection
For Each objLocalFileInfo In colLocalFileInfo
For Each objRemoteFileInfo In colRemoteFileInfo
' if it was the same file
If objLocalFileInfo.sFileName = objRemoteFileInfo.sFileName Then
' the file was exist
objRemoteFileInfo.bFileExist = True
If objLocalFileInfo.sFileSize <> objRemoteFileInfo.sFileSize _
Then
'objLocalFileInfo.sModifiedDate <> objRemoteFileInfo.sModifiedDate Or
objRemoteFileInfo.bUpdate = True
End If
End If
Next
Next
Set colUpdateFile = New Collection
For Each objRemoteFileInfo In colRemoteFileInfo
If objRemoteFileInfo.bFileExist = False Or objRemoteFileInfo.bUpdate _
= True Then
objRemoteFileInfo.sFileName = URLEncode(objRemoteFileInfo.sFileName)
colUpdateFile.Add objRemoteFileInfo
End If
Next
Set GetUpdateFile = colUpdateFile
Set colUpdateFile = Nothing
Set objRemoteFileInfo = Nothing
Set objLocalFileInfo = Nothing
End Function
Public Function GenerateUpdateXml(ByVal colFileInfo As Collection) As String
Dim objFileInfo As FILEINFO
Dim objRootElement As IXMLDOMElement
Dim objChileNode As IXMLDOMNode
Set objDomDocument = New DOMDocument
' Create the root element
Set objRootElement = objDomDocument.createElement(FILE_ROOT_ELEMENT)
' Create the child nodes
For Each objFileInfo In colFileInfo
Set objChileNode = CreateNode(objRootElement, FILE_ELEMENT)
CreateNode objChileNode, FILENAME_ELEMENT, objFileInfo.sFileName
CreateNode objChileNode, MODIFIEDDATE_ELEMENT, objFileInfo.sModifiedDate
CreateNode objChileNode, FILESIZE_ELEMENT, objFileInfo.sFileSize
Next
objDomDocument.appendChild objRootElement
GenerateUpdateXml = objDomDocument.xml
Set objDomDocument = Nothing
Set objChileNode = Nothing
Set objRootElement = Nothing
Set objFileInfo = Nothing
End Function
Public Function URLDecode(sEncodedURL As String) As String
On Error GoTo Catch
Dim iLoop As Integer
Dim sRtn As String
Dim sTmp As String
If Len(sEncodedURL) > 0 Then
For iLoop = 1 To Len(sEncodedURL)
sTmp = Mid(sEncodedURL, iLoop, 1)
sTmp = Replace(sTmp, "+", " ")
If sTmp = "%" And Len(sEncodedURL) > iLoop + 2 Then
sTmp = Mid(sEncodedURL, iLoop + 1, 2)
sTmp = Chr(CDec("&H" & sTmp))
iLoop = iLoop + 2
End If
sRtn = sRtn & sTmp
Next iLoop
URLDecode = sRtn
End If
Finally:
Exit Function
Catch:
URLDecode = ""
Resume Finally
End Function
Option Explicit
Public Function URLEncode(ByVal input_url As String) As String
Dim count As Long
Dim one_char As String
URLEncode = ""
For count = 1 To Len(input_url)
one_char = Mid$(input_url, count, 1)
If InStr("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCase$(one_char)) = 0 Then
one_char = "%" & Right$("0" & Hex$(Asc(one_char)), 2)
End If
URLEncode = URLEncode & one_char
Next
End Function