Click here to Skip to main content
15,897,273 members
Home / Discussions / Visual Basic
   

Visual Basic

 
GeneralRe: Help with small program Pin
Dave Kreskowiak20-Apr-04 11:32
mveDave Kreskowiak20-Apr-04 11:32 
GeneralVB 6 ODBC connection to SQL 2000 Pin
JumpinJimmy20-Apr-04 6:18
JumpinJimmy20-Apr-04 6:18 
GeneralRe: VB 6 ODBC connection to SQL 2000 Pin
jimpar20-Apr-04 7:02
jimpar20-Apr-04 7:02 
GeneralRe: VB 6 ODBC connection to SQL 2000 Pin
JumpinJimmy20-Apr-04 10:01
JumpinJimmy20-Apr-04 10:01 
GeneralRe: VB 6 ODBC connection to SQL 2000 Pin
RichardGrimmer21-Apr-04 2:38
RichardGrimmer21-Apr-04 2:38 
QuestionDatabase connection error??? Pin
hounetdev20-Apr-04 5:07
hounetdev20-Apr-04 5:07 
QuestionHow do I autoupdate my application? Pin
ruseno20-Apr-04 4:08
ruseno20-Apr-04 4:08 
AnswerRe: How do I autoupdate my application? Pin
Michael Russell20-Apr-04 4:52
Michael Russell20-Apr-04 4:52 
There are tons of ways. Pretty much all of them require a second executable.

Here is the source used for updating programs on our Intranet. There is update detection code in each executable. When that executable detects that there are updates available, it notifies the user. When the user says "Update," the program launches the updater and closes.

This isn't the cleanest or most secure code, but it works.

Imports System.IO
Imports System.Net

Public Class frmMain
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents RichTextBox1 As System.Windows.Forms.RichTextBox
    Friend WithEvents ProgressBar1 As System.Windows.Forms.ProgressBar
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frmMain))
        Me.Button1 = New System.Windows.Forms.Button
        Me.RichTextBox1 = New System.Windows.Forms.RichTextBox
        Me.ProgressBar1 = New System.Windows.Forms.ProgressBar
        Me.SuspendLayout()
        '
        'Button1
        '
        Me.Button1.Enabled = False
        Me.Button1.FlatStyle = System.Windows.Forms.FlatStyle.System
        Me.Button1.Location = New System.Drawing.Point(360, 8)
        Me.Button1.Name = "Button1"
        Me.Button1.Size = New System.Drawing.Size(72, 32)
        Me.Button1.TabIndex = 2
        Me.Button1.Text = "Launch"
        '
        'RichTextBox1
        '
        Me.RichTextBox1.Location = New System.Drawing.Point(8, 48)
        Me.RichTextBox1.Name = "RichTextBox1"
        Me.RichTextBox1.Size = New System.Drawing.Size(424, 224)
        Me.RichTextBox1.TabIndex = 3
        Me.RichTextBox1.Text = ""
        '
        'ProgressBar1
        '
        Me.ProgressBar1.Location = New System.Drawing.Point(8, 8)
        Me.ProgressBar1.Name = "ProgressBar1"
        Me.ProgressBar1.Size = New System.Drawing.Size(344, 32)
        Me.ProgressBar1.TabIndex = 4
        '
        'frmMain
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(442, 280)
        Me.ControlBox = False
        Me.Controls.Add(Me.ProgressBar1)
        Me.Controls.Add(Me.RichTextBox1)
        Me.Controls.Add(Me.Button1)
        Me.Font = New System.Drawing.Font("Verdana", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
        Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
        Me.Name = "frmMain"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Updating Software..."
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub CopyFromInternet(ByVal Source As String, ByVal Destination As String, Optional ByVal Size As Long = 0)
        Dim wc As New WebClient

        ' Does the file exist?
        Dim str As Stream
        Dim outstr As Stream
        Dim bw As BinaryWriter
        Dim br As BinaryReader
        Try
            str = wc.OpenRead(Source)
            If wc.ResponseHeaders.Item("Content-Type") = "text/html" Then
                If wc.ResponseHeaders.Item("Content-Location").IndexOf("404") > 0 Then
                    Throw New FileNotFoundException("The file '" & Source & "' was not found.")
                End If
            End If
        Finally
            str.Close()
        End Try

        Debug.WriteLine("Destination: " & Destination)
        ' Download the file
        If Size = 0 Then
            wc.DownloadFile(Source, Destination)
        Else
            str = wc.OpenRead(Source)
            br = New BinaryReader(str)
            outstr = New FileStream(Destination, FileMode.Create)
            bw = New BinaryWriter(outstr)
            For x As Integer = 1 To Math.Floor(Size / 4096)
                bw.Write(br.ReadBytes(4096))
            Next
            bw.Write(br.ReadBytes(Size Mod 4096))
            bw.Close()
            br.Close()
            outstr.Close()
            str.Close()
        End If

        wc.Dispose()
    End Sub

    Private Sub RtfWrite(ByVal TextColor As Color, ByVal Text As String)
        RichTextBox1.SelectionColor = TextColor
        RichTextBox1.AppendText(Text)
        Application.DoEvents()
    End Sub

    Private Sub RtfWriteLine(ByVal TextColor As Color, ByVal Text As String)
        RtfWrite(TextColor, Text & ControlChars.CrLf)
    End Sub

    Private ReadOnly DEBUG_TEXT As Color = Color.Gray
    Private ReadOnly NORMAL_TEXT As Color = Color.Black
    Private ReadOnly ERROR_TEXT As Color = Color.Red

    Private LaunchPath As String
    Private BadInstall As Boolean = False

    Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim params() As String = Environment.GetCommandLineArgs

        If params.GetUpperBound(0) <> 3 Then ' Wrong parameter count
            MsgBox("This program was launched incorrectly.  Please contact support.", MsgBoxStyle.OKOnly, "Error AutoUpdating Application")
            Application.Exit()
            Exit Sub ' Used because in release mode, the application will continue past this point.
        End If

        LaunchPath = params(3)

        'Application.EnableVisualStyles()
        Me.Show()
        Application.DoEvents()

        ' Get our temp folder
        Dim temppath As String = Path.GetTempFileName
        If File.Exists(temppath) Then File.Delete(temppath)
        Directory.CreateDirectory(temppath)

        Dim sr As StreamReader

        Try
            RtfWrite(NORMAL_TEXT, "Retrieving update information...")
            CopyFromInternet(params(1), temppath & "\updateinfo.txt")
            RtfWriteLine(NORMAL_TEXT, "done.")

            sr = New StreamReader(temppath & "\updateinfo.txt")
            ProgressBar1.Value = 0
            ProgressBar1.Minimum = 0
            ProgressBar1.Maximum = sr.BaseStream.Length + 2 ' In case the last line doesn't have a CRLF
            While sr.Peek <> -1

                Dim s As String = sr.ReadLine
                ProgressBar1.Value += s.Length + 2
                s = s.Trim
                Dim process As Boolean = True

                If s.StartsWith("'") Then process = False
                If s.Length = 0 Then process = False
                If s.IndexOf(",") = -1 Then process = False

                If process Then

                    Dim fparams() As String = s.Split(",")

                    If fparams.GetUpperBound(0) < 1 Or fparams.GetUpperBound(0) > 2 Then
                        Throw New ArgumentException("The update file was not properly formed.")
                    End If
                    RtfWrite(NORMAL_TEXT, "Retrieving " & fparams(1) & "...")
                    If fparams.GetUpperBound(0) = 1 Then
                        CopyFromInternet(fparams(0), temppath & "\" & fparams(1))
                    Else
                        CopyFromInternet(fparams(0), temppath & "\" & fparams(1), CLng(fparams(2)))
                    End If
                    RtfWriteLine(NORMAL_TEXT, "done.")

                End If


            End While

            ProgressBar1.Value = 0
            Dim di As New DirectoryInfo(temppath)
            ProgressBar1.Maximum = di.GetFiles.GetUpperBound(0) + 1

            If Not Directory.Exists(params(2)) Then
                Directory.CreateDirectory(params(2))
            End If

            RtfWrite(NORMAL_TEXT, "Installing update to " & params(2) & "...")
            Try
                For Each f As FileInfo In di.GetFiles
                    Dim CopyTo As String = params(2) & "\" & f.Name
                    If File.Exists(CopyTo) Then
                        File.SetAttributes(CopyTo, FileAttributes.Archive)
                    End If
                    f.CopyTo(CopyTo, True)
                    ProgressBar1.Value += 1
                    Application.DoEvents()
                Next
                RtfWriteLine(NORMAL_TEXT, "done.")
            Catch ex As Exception
                RtfWriteLine(ERROR_TEXT, "ERROR!")
                RtfWriteLine(ERROR_TEXT, "DO NOT USE THIS PROGRAM UNTIL IT IS REINSTALLED!")
                RtfWriteLine(ERROR_TEXT, "One or more of the files necessary to use the program did not install properly.")
                RtfWriteLine(ERROR_TEXT, "Please contact support immediately.")
                BadInstall = True
                Button1.Text = "Close"
            End Try

        Catch ex As Exception
            RtfWriteLine(NORMAL_TEXT, "")
            RtfWriteLine(ERROR_TEXT, "ERROR: " & ex.Message)
            RtfWriteLine(ERROR_TEXT, ex.StackTrace)
        Finally
            ' Clean up temp files
            If Not sr Is Nothing Then sr.Close()
            If Directory.Exists(temppath) Then
                Directory.Delete(temppath, True)
            End If
            Button1.Enabled = True
        End Try

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If Not BadInstall Then
            Dim objProcess As New System.Diagnostics.Process
            objProcess.StartInfo.FileName = LaunchPath
            objProcess.StartInfo.WindowStyle = ProcessWindowStyle.Normal
            objProcess.Start()
        End If
        Application.Exit()
    End Sub
End Class

Module InPoint
    Sub Main()
        Application.EnableVisualStyles()
        Application.DoEvents()
        Dim f As New frmMain
        f.ShowDialog()
    End Sub
End Module

GeneralStay inside MDI Client Area Pin
Michael Russell19-Apr-04 11:57
Michael Russell19-Apr-04 11:57 
GeneralRe: Stay inside MDI Client Area Pin
Dave Kreskowiak20-Apr-04 4:09
mveDave Kreskowiak20-Apr-04 4:09 
GeneralRe: Stay inside MDI Client Area Pin
Michael Russell20-Apr-04 4:47
Michael Russell20-Apr-04 4:47 
GeneralRe: Stay inside MDI Client Area Pin
Dave Kreskowiak20-Apr-04 5:31
mveDave Kreskowiak20-Apr-04 5:31 
QuestionHow do I Pin
KORCARI19-Apr-04 10:08
KORCARI19-Apr-04 10:08 
AnswerRe: How do I Pin
Daniel Turini19-Apr-04 10:28
Daniel Turini19-Apr-04 10:28 
QuestionHow do I Pin
KORCARI19-Apr-04 10:06
KORCARI19-Apr-04 10:06 
AnswerRe: How do I Pin
Dave Kreskowiak20-Apr-04 3:49
mveDave Kreskowiak20-Apr-04 3:49 
QuestionHow do I Pin
Anonymous19-Apr-04 10:00
Anonymous19-Apr-04 10:00 
GeneralPackage and Deployment Wizard VB6 Pin
krekre19-Apr-04 6:46
krekre19-Apr-04 6:46 
GeneralRe: Package and Deployment Wizard VB6 Pin
Roger Wright19-Apr-04 7:17
professionalRoger Wright19-Apr-04 7:17 
GeneralRe: Package and Deployment Wizard VB6 Pin
krekre19-Apr-04 8:31
krekre19-Apr-04 8:31 
GeneralRe: Package and Deployment Wizard VB6 Pin
Mike Dimmick19-Apr-04 8:59
Mike Dimmick19-Apr-04 8:59 
GeneralRe: Package and Deployment Wizard VB6 Pin
krekre19-Apr-04 9:57
krekre19-Apr-04 9:57 
GeneralEmail in VB .NET Pin
Jubal1519-Apr-04 6:08
Jubal1519-Apr-04 6:08 
GeneralRe: Email in VB .NET Pin
Dave Kreskowiak19-Apr-04 9:40
mveDave Kreskowiak19-Apr-04 9:40 
GeneralRe: Email in VB .NET Pin
Jubal1519-Apr-04 19:39
Jubal1519-Apr-04 19:39 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.