软件自动升级(旧版) 有新的用c#基于ftp自动更新

gfrv

　　Option Explicit
'---------------------------------------------------
' 这是一个用于将EXE文件从SQL SERVER中上传或下传的程序
'     读取命令行参数:EXE文件名及版本号
'     使用与EXE同名的INI为登录SQL SERVER
'     完成后以*****为命令行参数调用相应的EXE  作者:陈炎和
'---------------------------------------------------
　　'数据库定义,要先增加一个名称与应用程序相同的记录
　　'CREATE TABLE [dbo].[xt_应用程序] (
' [应用程序] [tinyint] NOT NULL ,
' [名称] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ,
' [主版本] [tinyint] NOT NULL ,
' [次版本] [tinyint] NOT NULL ,
' [修正版本] [tinyint] NOT NULL ,
' [文件] [image] NOT NULL ) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]

Public gConn As New ADODB.Connection
'------------------------------------
'主程序
'------------------------------------
Sub Main()
Dim Arrini() As String, i As Integer, ServerName As String, DataBase As String, UserName As String, Password As String
Dim Exename() As String, d As Date
On Error GoTo Errshow
Exename = GetCommandLine(3)
传送提示.Show   '请自行加入一个窗体,显示传送的信息
d = Now()
Do Until DateDiff("s", d, Now) > 3
   DoEvents
Loop
   '获取配置文件的信息 请在此加入读取的变量:servername,database,username,password

   'Arrini = GetIni(App.Path & IIf(Len(App.Path) > 3, "/", "") & Exename(0) & ".ini")
　　gConn.Open "Data Source=" & ServerName & ";Initial Catalog=" & DataBase & ";", UserName, Password
   
　　If GetRevision(Exename(0), Val(Exename(1)), Val(Exename(2)), Val(Exename(3))) Then
      Exename(0) = App.Path & IIf(Len(App.Path) > 3, "/", "") & Exename(0) & ".exe  *****"
      Call Shell(Exename(0), vbNormalFocus)
   End If
   gConn.Close
   Unload 传送提示
   Exit Sub
Errshow:
  Unload 传送提示
  ShowErr "call by " & App.Title
End Sub
'----------------------------------
'获取指定程序的版本号
'----------------------------------
Private Function GetRevision(ByVal Exename As String, ByVal Major As Byte, ByVal Minor As Byte, ByVal Revision As Byte) As Boolean
Dim Rec As ADODB.Recordset, FileName As String
On Error GoTo Errshow
Set Rec = New ADODB.Recordset
Rec.Open "select 应用程序,主版本,次版本,修正版本,文件 from xt_应用程序 where 名称 = '" & Exename & "'", gConn, adOpenDynamic, adLockOptimistic
If Not Rec.EOF Then
   FileName = App.Path & IIf(Len(App.Path) > 3, "/", "") & Exename & ".exe"
   If Rec(1) = Major And Rec(2) = Minor And Rec(3) = Revision Then
      GetRevision = True
   ElseIf (Rec(1) > Major) Or (Rec(1) = Major And Rec(2) > Minor) Or (Rec(1) = Major And Rec(2) = Minor And Rec(3) > Revision) Then
      传送提示.Label1 = "正在下传数据......."
      GetRevision = ReadbolbToFile(Rec.Fields(4), FileName)
   Else
      传送提示.Label1 = "数据上传"
      GetRevision = AppendBlobFromFile(Rec.Fields(4), FileName)
      Rec.Fields(1) = Major
      Rec.Fields(2) = Minor
      Rec.Fields(3) = Revision
      Rec.Update
   End If
Else
  GetRevision = False
End If
Rec.Close
Set Rec = Nothing
Exit Function
Errshow:
  ShowErr "call by GetRevision"
End Function
　　Public Sub ShowErr(Optional ByVal Msg As String)
If Err.Number <> 0 Then
    MsgBox &quot;错误：&quot; & vbCrLf & Err.Description & vbCrLf & Msg, vbOKOnly
End If
End Sub
'----------------------
' 获取命令行参数
'----------------------
Public Function GetCommandLine(Optional MaxArgs) As String()
Dim C, CmdLine, CmdLnLen, InArg, i, NumArgs
If IsMissing(MaxArgs) Then MaxArgs = 10  '检查是否提供了 MaxArgs 参数。
ReDim argarray(MaxArgs) As String
NumArgs = -1
InArg = False
CmdLine = Command$
CmdLnLen = Len(CmdLine)
'以一次一个字符的方式取出命令行参数。
For i = 1 To CmdLnLen
     C = Mid(CmdLine, i, 1)
     '检测是否为 space 或 tab。
     If (C <> &quot; &quot; And C <> vbTab) Then '若既不是 space 键，也不是 tab 键，
         If Not InArg Then '则检测是否为参数内含之字符。
            '检测参数是否过多。
            If NumArgs = MaxArgs Then Exit For
            NumArgs = NumArgs &#43; 1
            InArg = True
         End If
         '将字符连接到当前参数中。
         argarray(NumArgs) = argarray(NumArgs) & C
     Else
         '找到 space 或 tab。将 InArg 标志设置成 False。
         InArg = False
     End If
Next i
GetCommandLine = argarray()
End Function
　　'程序-: 写数据函数
Public Function AppendBlobFromFile(blobColumn As ADODB.Field, ByVal FileName) As Boolean
Dim FileNumber      As Integer      '文件号
Dim DataLen         As Long         '文件长度
Dim Chunks          As Long         '数据块数
Dim ChunkAry()      As Byte         '数据块数组
Dim ChunkSize       As Long         '数据块大小
Dim Fragment        As Long         '零碎数据大小
Dim lngI            As Long         '计数器
　　On Error GoTo ErrorHandle
AppendBlobFromFile = False
ChunkSize = 2048                    '限制每次读取的块大小为 2K
　　FileNumber = FreeFile               '产生随机的文件号
Open FileName For Binary Access Read As FileNumber      '打开图像文件
DataLen = LOF(FileNumber)           '获得文件长度
If IsNull(blobColumn) Then Exit Function
　　If DataLen = 0 Then                 '文件长度为0
    Close FileNumber
    AppendBlobFromFile = True
    Exit Function
End If
   
Chunks = DataLen / ChunkSize        '数据块的个数
Fragment = DataLen Mod ChunkSize
If Fragment > 0 Then                '先写零碎数据
    ReDim ChunkAry(Fragment - 1)
    Get FileNumber, , ChunkAry()    '读出文件
    blobColumn.AppendChunk ChunkAry '调用AppendChunk函数写数据
End If
   
ReDim ChunkAry(ChunkSize - 1)           '为数据块开辟空间
For lngI = 1 To Chunks                  '循环读出所有数据块
    Get FileNumber, , ChunkAry()        '读出一块数据
    blobColumn.AppendChunk ChunkAry     '在数据库中增加数据块
Next lngI
   
Close FileNumber            '关闭文件
AppendBlobFromFile = True
Exit Function
ErrorHandle:
AppendBlobFromFile = False
MsgBox Err.Description, vbCritical, &quot;写文件数据出错!&quot;
End Function
　　'程序二: 读数据函数
Public Function ReadbolbToFile(blobColumn As ADODB.Field, ByVal FileName) As Boolean
Dim FileNumber      As Integer      '文件号
Dim DataLen         As Long         '文件长度
Dim Chunks          As Long         '数据块数
Dim ChunkAry()      As Byte         '数据块数组
Dim ChunkSize       As Long         '数据块大小
Dim Fragment        As Long         '零碎数据大小
Dim lngI            As Long         '计数器
   
On Error GoTo ErrorHandle
ReadbolbToFile = False
ChunkSize = 2048                        '定义块大小为 2K
If IsNull(blobColumn) Then Exit Function

DataLen = blobColumn.ActualSize         '获得图像大小
'If DataLen < 8 Then Exit Function       '图像大小小于8字节时认为不是图像信息
FileNumber = FreeFile                   '产生随机的文件号
Open FileName For Binary Access Write As FileNumber     '打开存放图像数据文件
Chunks = DataLen / ChunkSize            '数据块数
Fragment = DataLen Mod ChunkSize        '零碎数据
If Fragment > 0 Then                    '有零碎数据，则先读该数据
    ReDim ChunkAry(Fragment - 1)
    ChunkAry = blobColumn.GetChunk(Fragment)
    Put FileNumber, , ChunkAry           '写入文件
End If
　　ReDim ChunkAry(ChunkSize - 1)           '为数据块重新开辟空间
For lngI = 1 To Chunks                  '循环读出所有块
     ChunkAry = blobColumn.GetChunk(ChunkSize)   '在数据库中连续读数据块
     Put FileNumber, , ChunkAry()                '将数据块写入文件中
Next lngI
Close FileNumber                        '关闭文件
ReadbolbToFile = True
Exit Function
ErrorHandle:
ReadbolbToFile = False
MsgBox Err.Description, vbCritical, &quot;读文件数据出错!&quot;
End Function
　　

         版权声明：本文为博主原创文章，未经博主允许不得转载。