I want to create desktop shortcut for exe file through program.
I do not want to use installer to do this.
Can a piece of code in program do this?How?
Chasler has answered that question a couple of years ago here on SO.
Add a reference to the Windows Script Host Object Model
Imports IWshRuntimeLibrary
Private Sub CreateShortCut(ByVal FileName As String, ByVal Title As String)
Try
Dim WshShell As New WshShell
' short cut files have a .lnk extension
Dim shortCut As IWshRuntimeLibrary.IWshShortcut = DirectCast(WshShell.CreateShortcut(FileName, IWshRuntimeLibrary.IWshShortcut)
' set the shortcut properties
With shortCut
.TargetPath = Application.ExecutablePath
.WindowStyle = 1I
.Description = Title
.WorkingDirectory = Application.StartupPath
' the next line gets the first Icon from the executing program
.IconLocation = Application.ExecutablePath & ", 0"
.Arguments = String.Empty
.Save() ' save the shortcut file
End With
Catch ex As System.Exception
MessageBox.Show("Could not create the shortcut" & Environment.NewLine & ex.Message, g_strAppTitleVersion, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
(Source)
This code works very well
Private Function CreateShortCut(ByVal TargetName As String, ByVal ShortCutPath As String, ByVal ShortCutName As String) As Boolean
Dim oShell As Object
Dim oLink As Object
'you don’t need to import anything in the project reference to create the Shell Object
Try
oShell = CreateObject("WScript.Shell")
oLink = oShell.CreateShortcut(ShortCutPath & "\" & ShortCutName & ".lnk")
oLink.TargetPath = TargetName
oLink.WindowStyle = 1
oLink.Save()
Catch ex As Exception
End Try
End Function
Credits
Related
Hello again StackOverflow community!
I am working on a class "SendLogfileClass". In this class I send a logfile via email to said email account. That part works as intended. What I am having problems with is trying to process the Async Completion Event. During said event a Addhandler fires and sets a StatusBar.StatusLabel on the main form.
Here are some relevant chunks of code:
#Region "Imports"
Imports System
Imports System.Net
Imports System.Net.Mail
Imports System.Net.Mime
Imports System.Threading
Imports System.ComponentModel
Imports System.IO
#End Region
Public Class Form1
#Region "Public"
Private SendmailThread As Thread
Private MailBody As String = Nothing
#End Region
#Region "Private"
Private mailSent As Boolean = False
#End Region
Public Function GetTimestamp() As String
Dim t As Date = Date.Now
Dim timestamp As String = Nothing
Try
timestamp = t.ToLongTimeString & " " & t.ToLongDateString
Catch ex As Exception
Return 1
End Try
Return timestamp
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Try
If LoggerClock.Enabled = True Then
OutputConsole.Text = "logger Started: " & GetTimestamp() & vbNewLine
OutputConsole.AppendText("Logfile Opened: " & GetTimestamp() & vbNewLine)
StatusLabel.Text = "Logger Status: Active"
StatusBar.Refresh()
Else
OutputConsole.Text = "logger Started: " & GetTimestamp() & vbNewLine
StatusLabel.Text = "Logger Status: Inactive"
StatusBar.Refresh()
End If
SendlogClock.Enabled = True
ToggleViewForm(1)
Catch ex As Exception
Exit Sub
End Try
End Sub
Public Function SetStatus(ByVal [status] As String) As Integer
Try
Thread.Sleep(1000)
StatusLabel.Text = [status]
StatusBar.Refresh()
Catch ex As Exception
Return 1
End Try
Return 0
End Function
Private Sub SendlogThreadTask()
Try
SendLogfile("user#gmail.com", "Logger Logfile", MailBody).ToString()
Catch ex As Exception
Exit Sub
End Try
End Sub
Private Sub SendlogClock_Tick(sender As Object, e As EventArgs) Handles SendlogClock.Tick
Try
OutputConsole.AppendText("Logfile Closed: " & GetTimestamp() & vbNewLine)
SendmailThread = New Thread(AddressOf SendlogThreadTask)
SendmailThread.IsBackground = True
SendmailThread.Start()
OutputConsole.ResetText()
OutputConsole.Text = "Logfile Opened: " & GetTimestamp() & vbNewLine
Catch ex As Exception
Exit Sub
End Try
End Sub
Public Sub SendCompletedCallback(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
Try
' Get the unique identifier for this asynchronous operation.
Dim token As String = CStr(e.UserState)
If e.Cancelled Then
StatusLabel.Text = "Send Canceled... " & token
StatusBar.Refresh()
End If
If e.Error IsNot Nothing Then
StatusLabel.Text = "Error: " & token & " " & e.Error.ToString() & " "
StatusBar.Refresh()
Else
StatusLabel.Text = "Message Sent... "
StatusBar.Refresh()
End If
mailSent = True
Catch ex As Exception
Exit Sub
End Try
End Sub
Public Function SendLogfile(ByVal mailTo As String, ByVal mailSubject As String, ByVal mailBody As String, Optional ByVal doAttach As Boolean = False, Optional ByVal messageAttach As String = Nothing) As Integer
Try
' SMTP Server
Dim SmtpServer As String = "mail.domain.com"
' Command line argument must the the SMTP host.
Dim Cli As New SmtpClient(SmtpServer)
' Specify the e-mail sender.
' Create a mailing address that includes a UTF8 character
' in the display name.
Dim [from] As New MailAddress("logger#domain.com", "logger " & ChrW(&HD8) & " logs", System.Text.Encoding.UTF8)
' Set destinations for the e-mail message.
Dim [to] As New MailAddress(mailTo)
' Specify the message content.
Dim message As New MailMessage([from], [to])
message.Body = mailBody
' Include some non-ASCII characters in body and subject.
Dim someArrows As New String(New Char() {ChrW(&H2190), ChrW(&H2191), ChrW(&H2192), ChrW(&H2193)})
message.Body += Environment.NewLine & someArrows
message.BodyEncoding = System.Text.Encoding.UTF8
message.Subject = mailSubject & someArrows
message.SubjectEncoding = System.Text.Encoding.UTF8
' Put the mail attachment in a list of items
'Dim attachment As New Attachment(messageAttach)
' Attach file.
'If doAttach = True Then
'If File.Exists(messageAttach) Then
'message.Attachments.Add(attachment)
'End If
'End If
' Set the method that is called back when the send operation ends.
AddHandler Cli.SendCompleted, AddressOf SendCompletedCallback
' The userState can be any object that allows your callback
' method to identify this send operation.
' For this example, the userToken is a string constant.
Dim userState As String = "OK"
Cli.SendAsync(message, userState)
'MsgBox("Sending message... press c to cancel mail. Press any other key to exit.")
Dim answer As String = "OK" ' or CANCEL
' If the user canceled the send, and mail hasn't been sent yet,
' then cancel the pending operation.
If answer.StartsWith("C") AndAlso mailSent = False Then
Cli.SendAsyncCancel()
End If
' Clean up.
message.Dispose()
Catch ex As Exception
MsgBox("Encountered Error: " & vbNewLine & vbNewLine & ex.ToString())
Return 1
End Try
Return 0
End Function
End Class
Your event handler is executed on a secondary thread and in that event handler you are referring to the default instance of MainForm. Default instances are thread-specific so that is a different form object to the one you're looking at on-screen.
You can generally use the SynchronizationContext class to enable marshalling a method call to the UI thread but that's not possible in your case because you're actually creating the object on a secondary thread too. In that case, you'll have to pass a reference to the existing MainForm object into that mail sender and use that to marshal a method call to the UI thread using its InvokeRequired and Invoke/BeginInvoke members.
I'm trying to write some text lines to a little log file in a Windows Form application and I cannot see why no lines are written. The file gets created OK and all of the following executes without error but when I open the new file with Notepad, there are no lines. Key snippets follow:
Dim sFileName = App_Path() & "\logs\" & sJobName & ".log"
Try
Using fs As FileStream = New FileStream(sFileName, FileMode.Append, FileAccess.Write)
Using w As StreamWriter = New StreamWriter(fs)
Dim s As String = "Beginning execution (JobName=" & sJobName & ")"
Log(s, w)
s = "Connection in effect: " & BuildConnectString()
Log(s, w)
Dim loader As New Importer
loader.LoadData(Me.txtFN.Text, w)
End Using
End Using
Catch ex As Exception
MsgBox(ex.Message)
End Try
Public Sub Log(logMessage As String, w As StreamWriter)
w.WriteLine("{0} {1}: {2}", DateTime.Now.ToLongTimeString(), _
DateTime.Now.ToShortDateString(), logMessage)
End Sub
and then I'm trying to write to this log from a different class which has been passed the StreamWriter as a parameter:
Public Function LoadData(ByRef filename As String, _
ByRef w As StreamWriter) As String
Dim s As String = "Test logging from loader class"
Mainform.Log(s, w)
In this little test, I am expecting to see 3 lines but I'm getting nothing. I cannot see what I am doing wrong.
It works for me, but if the code doesn't work for you, you can use code like this ...
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim sFileName = App_Path() & "\logs\" & sJobName & ".log"
Try
Dim s As String = "Beginning execution (JobName=" & sJobName & ")"
Log(s, sFileName)
s = "Connection in effect: " & BuildConnectString()
Log(s, sFileName)
Dim loader As New Importer
loader.LoadData(Me.txtFN.Text, sFileName)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Public Sub Log(logMessage As String, StrPath As String)
IO.File.AppendAllText(StrPath, String.Format("{0} {1}: {2}", DateTime.Now.ToLongTimeString(), DateTime.Now.ToShortDateString(), logMessage) + vbCrLf)
End Sub
Public Function LoadData(ByRef filename As String, _
StrPath As String) As String
Dim s As String = "Test logging from loader class"
Log(s, StrPath)
End Function
I have this code and it's giving troubles:
Imports IWshRuntimeLibrary
Imports Shell32
Public Sub CreateShortcutInStartUp(ByVal Descrip As String)
Dim WshShell As WshShell = New WshShell()
Dim ShortcutPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Startup)
Dim Shortcut As IWshShortcut = CType(WshShell.CreateShortcut(ShortcutPath &
Application.ProductName & ".lnk"), IWshShortcut)
Shortcut.TargetPath = Application.ExecutablePath
Shortcut.WorkingDirectory = Application.StartupPath
Shortcut.Descripcion = Descrip
Shortcut.Save()
End Sub
According to what I have read, this is how you create a shortcut in Startup. But, no matter how much I call this Sub, shortcut does not show up. I ALREADY look up to a lot of similar questions around S.O and various other sites.
I even tried to create the shortcut from other application and still doesn't show up as expected.
What am I missing?
You have two errors in your code:
1) The path isn't being concatenated properly so change this:
Dim Shortcut As IWshShortcut = CType(WshShell.CreateShortcut(ShortcutPath & Application.ProductName & ".lnk"), IWshShortcut)
to this:
Dim Shortcut As IWshShortcut = CType(WshShell.CreateShortcut(System.IO.Path.Combine(ShortcutPath, Application.ProductName) & ".lnk"), IWshShortcut)
2) You spelled Description wrong so change:
Shortcut.Descripcion = Descrip
to this:
Shortcut.Description = Descrip
Here is the fixed subroutine:
Public Sub CreateShortcutInStartUp(ByVal Descrip As String)
Dim WshShell As WshShell = New WshShell()
Dim ShortcutPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Startup)
Dim Shortcut As IWshShortcut = CType(WshShell.CreateShortcut(System.IO.Path.Combine(ShortcutPath, Application.ProductName) & ".lnk"), IWshShortcut)
Shortcut.TargetPath = Application.ExecutablePath
Shortcut.WorkingDirectory = Application.StartupPath
Shortcut.Description = Descrip
Shortcut.Save()
End Sub
Imports Microsoft.Win32 and
Imports IWshRuntimeLibrary
TO CREATE A SHORTCUT
Private Sub btnCreateShortcut_Click_(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCreateShortcut.Click
'To create Start shortcut in the windows Startup folder:
Dim WshShell As WshShell = New WshShell
Dim SRT As String = Environment.GetFolderPath(Environment.SpecialFolder.Startup)
'Fixing the Shortcut Location instead of StartupScreenLocker
'Name your Shortcut, Example \ScreenLocker.Ink
Dim ShortcutPath As String = SRT & "\ScreenLocker.lnk"
'Add shortcut.
Dim Shortcut As IWshRuntimeLibrary.IWshShortcut
Shortcut = CType(WshShell.CreateShortcut(ShortcutPath), IWshRuntimeLibrary.IWshShortcut)
Shortcut.TargetPath = Application.ExecutablePath
Shortcut.WorkingDirectory = Application.StartupPath
Shortcut.Save()
End Sub
TO DELETE THE SHORTCUT
Private Sub btnDeleteShortcut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDeleteShortcut.Click
'To create Start shortcut in the windows Startup folder:
Dim Shortcut As String = Environment.GetFolderPath(Environment.SpecialFolder.Startup)
'Name the Shortcut you want to delete, Example \ScreenLocker.Ink
Dim ShortcutPath As String = Shortcut & "\ScreenLocker.lnk"
'To delete the shortcut:
If IO.File.Exists(ShortcutPath) Then
IO.File.Delete(ShortcutPath)
End If
End Sub
I am trying to call a function in one class from another on a Timer.Elapsed. I can call test functions just fine, but when I call the actual function I want, I get no exceptions, but the function just doesn't run. I have tried adding in some error handling (Catch ex) and outputting frequent messages to a .txt file to see where it fails, but I am not getting any of these messages in my log when I know that the function I am using to write these messages to the log is working.
How can I find where my function contains an error if I have no access to error messages?
Adding my code below - this is my write to log function.
Public Shared Function Output_To_Log(ByVal message As String) As String
Dim strDate As String = Now.ToString("dd MMM yy HH:mm:ss ")
Dim strTodayDate As String = Now.ToString("yyyyMMMdd")
Dim file As New FileStream("C:\PHJones_Windows_Service\logs\Log" & strTodayDate & ".txt", FileMode.Append, FileAccess.Write)
Dim stream As New StreamWriter(file)
stream.WriteLine(message & " : " & strDate)
stream.Close()
Return ""
End Function
This is my Timer elapsed function.
Private Shared Sub Timer1_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed
Output_To_Log("Working")
PHJones.Start_Batch()
End Sub
This is my Start_Batch function, with references to my server blanked out with ****
Public Shared Function Start_Batch() As Integer
Try
Dim a As New running_check
a.check = 1
Dim files As String()
Dim File As String
Dim myProcess As New Diagnostics.Process()
Dim File_Name As String
Dim Running_FileName As String
RunTimer.Output_To_Log("Start_Batch starting")
Start:
RunTimer.Output_To_Log("Checking logs")
Dim log_check As Integer = check_logs()
RunTimer.Output_To_Log("Getting .DAT files.")
files = IO.Directory.GetFiles("****\phjones\to_phjones\", "*.DAT")
If files.Count > 0 Then
RunTimer.Output_To_Log("Counted " & files.Count & " files.")
Else
RunTimer.Output_To_Log("No files found.")
End If
For Each File In files
Try
RunTimer.Output_To_Log("Starting process for " & File)
Running_FileName = File & ".BAT"
RunTimer.Output_To_Log("Processing " & Running_FileName)
File_Name = File.Substring(26)
If System.IO.File.Exists("C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT") Then
RunTimer.Output_To_Log("C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT already exists")
Else
RunTimer.Output_To_Log("Copying " & Running_FileName & " to batch_files folder")
System.IO.File.Copy(Running_FileName, "C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT", True)
End If
If (System.IO.File.Exists("C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT")) Then
If (System.IO.File.Exists(Running_FileName)) Then
RunTimer.Output_To_Log("Deleting file " & Running_FileName)
System.IO.File.Delete(Running_FileName)
Else
RunTimer.Output_To_Log(File_Name & ".BAT does not exist in ****\phjones\to_phjones\processed")
End If
Else
RunTimer.Output_To_Log(File_Name & ".BAT failed to copy")
Throw New Exception(File_Name & ".BAT failed to copy to C:\PHJones_Windows_Service\Batch_Files")
End If
RunTimer.Output_To_Log("Executing batch file " & Running_FileName)
myProcess.StartInfo.UseShellExecute = True
myProcess.StartInfo.FileName = "C:\PHJones_Windows_Service\Batch_Files\" & File_Name & ".BAT"
myProcess.StartInfo.CreateNoWindow = False
myProcess.Start()
myProcess.WaitForExit()
If System.IO.File.Exists("****\phjones\to_phjones\" & File_Name) Then
RunTimer.Output_To_Log("****\phjones\to_phjones\" & File_Name & " already exists")
System.IO.File.Delete(File)
RunTimer.Output_To_Log(File & " has been deleted")
Else
RunTimer.Output_To_Log("Moving " & File)
System.IO.File.Move(File, "****\phjones\to_phjones\" & File_Name)
End If
Dim IWCnn = New OracleConnection(ConfigurationManager.ConnectionStrings("myConnectionString").ConnectionString)
Dim intRepair_Id As Integer = Mid(File_Name, 1, 7)
Dim intRepair_seq As Integer = Mid(File_Name, 8, 1)
RunTimer.Output_To_Log("Updating database for file " & File)
IWCnn.Open()
Dim StatusCmd As New OracleCommand("update works_orders " & _
"set wor_sco_code = 'ISS', wor_issued_datetime = sysdate" & _
" where wor_srq_no = " & intRepair_Id & _
" and wor_seqno = " & intRepair_seq, IWCnn)
StatusCmd.ExecuteNonQuery()
IWCnn.Close()
Catch ex As Exception
RunTimer.Timer1.Enabled = False
RunTimer.Output_To_Log("Exception thrown in PHJones 2010 - " & ex.Message)
Thread.Sleep(900000)
RunTimer.Timer1.Enabled = True
a.check = 0
Return 0
End Try
Next
a.check = 0
Catch ex As Exception
RunTimer.Output_To_Log("Exception thrown in PHJones 2010 - " & ex.Message)
End Try
Return 0
End Function
The entire RunTimer class.
Imports System.Configuration.ConfigurationSettings
Imports System.Data
Imports System.IO
Imports System.Diagnostics
Imports System
Imports System.Timers
Imports System.Threading
Imports System.ServiceProcess
Imports System.Configuration.Install
Public Class RunTimer
Inherits System.ServiceProcess.ServiceBase
Friend Shared WithEvents Timer1 As System.Timers.Timer
Public Counter As Integer = 0
Public Sub New()
MyBase.New()
InitializeComponents()
End Sub
Private Sub InitializeComponents()
Me.ServiceName = "RunTimer"
Me.AutoLog = True
Me.CanStop = True
Timer1 = New System.Timers.Timer()
Timer1.Interval = 15000
Timer1.Enabled = True
End Sub
' This method starts the service.
<MTAThread()> Shared Sub Main()
' To run more than one service you have to add them to the array
System.ServiceProcess.ServiceBase.Run(New System.ServiceProcess.ServiceBase() {New RunTimer})
End Sub
' Clean up any resources being used.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
MyBase.Dispose(disposing)
' TODO: Add cleanup code here (if required)
End Sub
Protected Overrides Sub OnStart(ByVal args() As String)
' TODO: Add start code here (if required) to start your service.
Timer1.Enabled = True
End Sub
Protected Overrides Sub OnStop()
' TODO: Add tear-down code here (if required) to stop your service.
Timer1.Enabled = False
Output_To_Log("Ended")
End Sub
Private Sub InitializeComponent()
Timer1 = New System.Timers.Timer
CType(Timer1, System.ComponentModel.ISupportInitialize).BeginInit()
Timer1.Enabled = True
CType(Timer1, System.ComponentModel.ISupportInitialize).EndInit()
End Sub
Private Shared Sub Timer1_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed
Output_To_Log("Working")
PHJones.Start_Batch()
End Sub
Since you're running as a service, you won't see ordinary error messages. It's possible there is an error between Output_To_Log("Working") in the Timer event and RunTimer.Output_To_Log("Start_Batch starting") of Start_Batch(). For example, if an error could occur in the initialization of Dim a As New running_check, or in the call itself, PHJones.Start_Batch(). Either of these would cause what you're seeing.
Here Is my code
Public Sub MoveAllFolders(ByVal fromPathInfo As DirectoryInfo, ByVal toPath As String)
Dim toPathInfo = New DirectoryInfo(toPath)
If (Not toPathInfo.Exists) Then
toPathInfo.Create()
End If
'move all folders
For Each dir As DirectoryInfo In fromPathInfo.GetDirectories()
dir.MoveTo(Path.Combine(toPath, dir.Name))
Next
End Sub
MoveAllFolders("D:\Users\TheUser!\Desktop\dd", "D:\Users\TheUser!\Desktop\dd\Folders)
My goal is to move all folder inside a folder into a folder named Folders.
so If I do it on desktop all the folders in desktop will go to "Folders"
but I get an error "The process cannot access the file because it is being used by another process."
so this code can't work this way, so is there any way to do what I wanna do?
Thanks alot!
You are moving your target-directoy into itself.
You could check if the destination-path contains the source-directory's FullName.
If Not toPath.Contains(fromPathInfo.FullName) Then
dir.MoveTo(IO.Path.Combine(toPath, dir.Name))
End If
But this method would be quite hacky. Consider a folder '"D:\abc1' and a folder '"D:\abc2'. Contains would return true in this case even if the folder "abc1" and "abc2" are not the same.
This should work better:
Public Sub MoveAllFolders(ByVal fromDir As IO.DirectoryInfo, ByVal toDir As IO.DirectoryInfo, Optional ByVal excludeList As List(Of String) = Nothing)
If (Not toDir.Exists) Then
toDir.Create()
End If
'move all folders
For Each dir As IO.DirectoryInfo In fromDir.GetDirectories()
Dim targetPath = IO.Path.Combine(toDir.FullName, dir.Name)
If Not toDir.FullName = dir.FullName _
AndAlso Not IsParentDirectory(toDir, dir) _
AndAlso Not IO.Directory.Exists(targetPath) _
AndAlso (excludeList Is Nothing _
OrElse Not excludeList.Contains(dir.FullName, StringComparer.InvariantCultureIgnoreCase)) Then
Try
dir.MoveTo(targetPath)
Catch ioEx As IO.IOException
'ignore this directory'
Catch authEx As UnauthorizedAccessException
'ignore this directory'
Catch ex As Exception
Throw
End Try
End If
Next
End Sub
Public Shared Function IsParentDirectory(ByVal subDir As IO.DirectoryInfo, ByVal parentDir As IO.DirectoryInfo) As Boolean
Dim isParent As Boolean = False
While subDir.Parent IsNot Nothing
If subDir.Parent.FullName = parentDir.FullName Then
isParent = True
Exit While
Else
subDir = subDir.Parent
End If
End While
Return isParent
End Function
You could use this function in this way:
Dim excludePathList As New List(Of String)
excludePathList.Add("C:\Temp\DoNotMoveMe1\")
excludePathList.Add("C:\Temp\DoNotMoveMe2\")
MoveAllFolders(New IO.DirectoryInfo("C:\Temp\"), New IO.DirectoryInfo("C:\Temp\temp-sub\"), excludePathList)
Edit: updated according to your last comment (untested).