'Shell Structures

  'wFunc - A value that indicates which operation to perform
  Public Const FO_MOVE = &H1
  Public Const FO_COPY = &H2
  Public Const FO_DELETE = &H3
  Public Const FO_RENAME = &H4

  'fFlags - Flags that control the file operation
  'Preserve undo information, if possible (класть в корзину)
  Public Const FOF_ALLOWUNDO = &H40
  'Respond with Yes to All for any dialog box that is displayed
  Public Const FOF_NOCONFIRMATION = &H10
  'Do not ask the user to confirm the creation of a new directory if required
  Public Const FOF_NOCONFIRMMKDIR = &H200
  'Do not copy the security attributes of the file.
  'The destination file receives the security attributes of its new folder.
  Public Const FOF_NOCOPYSECURITYATTRIBS = &H800
  'Do not display a dialog to the user if an error occurs.
  Public Const FOF_NOERRORUI = &H400
  'Do not display a progress dialog box.
  Public Const FOF_SILENT = &H4
  'Display a progress dialog box but do not show individual file names as they are operated on.
  Public Const FOF_SIMPLEPROGRESS = &H100
  'Windows Vista. Perform the operation silently, presenting no UI to the user.
  Public Const FOF_NO_UI = FOF_SILENT Or FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR Or FOF_NOERRORUI

  <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
  Public Structure SHFILEOPSTRUCT
    Dim hwnd As IntPtr
    Dim wFunc As Integer
    Dim pFrom As String
    Dim pTo As String
    Dim fFlags As Short
    Dim fAnyOperationsAborted As Boolean
    Dim hNameMappings As IntPtr
    Dim lpszProgressTitle As String
  End Structure

  Public Declare Unicode Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationW" _
   (ByRef lpFileOp As SHFILEOPSTRUCT) As Integer

  Public Function ShellCopyFileFolder(ByVal strSource As String, ByVal strTarget As String, _
   Optional ByVal bMove As Boolean = False, _
   Optional ByVal bSilent As Boolean = True, _
   Optional ByVal bNoConfirmMakeDir As Boolean = True, _
   Optional ByVal bNoConfirm As Boolean = True, _
   Optional ByVal bNoShowErrors As Boolean = True, _
   Optional ByVal bNoCopySecurityAttribs As Boolean = True) As Boolean
    'bMove -использовать Move вместо Copy
    'bSilent - не показывать диалог копирования
    'bNoConfirmMakeDir -создавать папку, куда копировать без подтверждения
    'bNoConfirm -не задавать пользователю лишних вопросов
    'bNoShowErrors -не выводить диалоги про ошибки
    'bNoCopySecurityAttribs - не копировать права на исх. файлы и папки

    'ВАЖНО!!! при копировании папок
    'если папка strTarget существует, то папка с именем strSource копируется в strTarget
    'если папка strTarget НЕ существует, то она создается в strTarget и туда копируется содержимое strSource

    Dim SHFileOp As New SHFILEOPSTRUCT  ' structure To pass To the Function
    Dim dwRes As Integer

    'коррекция
    strSource = InCorrectDir(strSource) & Chr(0) & Chr(0) 'убираем "\" на конце и добавляем "\0\0" 
    strTarget = InCorrectDir(strTarget) 'убираем "\" на конце

    With SHFileOp
      If bMove Then
        .wFunc = FO_MOVE
      Else
        .wFunc = FO_COPY
      End If
      .pFrom = strSource
      .pTo = strTarget
      If bSilent Then .fFlags = .fFlags Or FOF_SILENT
      If bNoConfirmMakeDir Then .fFlags = .fFlags Or FOF_NOCONFIRMMKDIR
      If bNoConfirm Then .fFlags = .fFlags Or FOF_NOCONFIRMATION
      If bNoShowErrors Then .fFlags = .fFlags Or FOF_NOERRORUI
      If bNoCopySecurityAttribs Then .fFlags = .fFlags Or FOF_NOCOPYSECURITYATTRIBS
    End With

    dwRes = SHFileOperation(SHFileOp)
    'If dwRes <> 0 Then Debug.Print "SHFileOperation Error " & CStr(dwRes)

    ShellCopyFileFolder = (dwRes = 0)

  End Function

  Public Function InCorrectDir(ByVal the_str As String) As String
    'здесь наоборот удаляем крайний слэш!
    If (Strings.Right(the_str, 1) = "\") Then
      InCorrectDir = Strings.Left(the_str, Strings.Len(the_str) - 1)
    Else
      InCorrectDir = the_str
    End If
  End Function

  Public Function FindShortcutByTagretName(ByVal pszFolder As String, ByVal pszTargetName As String, _
   Optional bTopDirectoryOnly As Boolean = True, Optional bInTheMiddle As Boolean = False) As String
    'возвращает путь к первому найденному ярлыку, указывающему на имя pszTargetName по заданному пути pszFolder
    'bTopDirectoryOnly - не искать ярлык в поддиректориях
    'bInTheMiddle=false -проверяет точное совпадение pszTargetName с GetFileName(sTarget)
    'bInTheMiddle=true -проверяет вхождение pszTargetName в строку sTarget, напр. pszTargetName='fxsclnt.exe' sTarget='...system32\fxsclnt.exe /new'
    Dim ff As String()
    If bTopDirectoryOnly Then
      ff = IO.Directory.GetFiles(pszFolder, "*.lnk", IO.SearchOption.TopDirectoryOnly)
    Else
      ff = IO.Directory.GetFiles(pszFolder, "*.lnk", IO.SearchOption.AllDirectories)
    End If
    For Each f As String In ff
      Dim sTarget As String = GetShortcutTarget(f)
      If Strings.Len(sTarget) > 0 Then
        If bInTheMiddle Then
          If (InStr(UCase(sTarget), UCase(pszTargetName)) > 0) Then Return f
        Else
          If UCase(IO.Path.GetFileName(sTarget)) = UCase(pszTargetName) Then Return f
        End If
      End If
    Next
    Return ""
  End Function


  Public Function GetShortcutTarget(ByVal pszShortcutPath As String) As String
    'путь к файлу, на кот. указывает ярлык
    Try
      Dim link As New ShellLink()
      DirectCast(link, IPersistFile).Load(pszShortcutPath, STGM_READ)
      Dim sb As New StringBuilder(MAX_PATH)
      Dim data As New WIN32_FIND_DATA
      DirectCast(link, IShellLinkW).GetPath(sb, sb.Capacity, data, 0)
      Return sb.ToString()
    Catch
      Return ""
    End Try
  End Function

  Public Function SetServiceAutoStart(ByVal ServiceName As String, ByVal bAutoStart As Boolean) As Boolean
    'admin
    SetServiceAutoStart = False
    ' Get a handle to the SCM database. 
    Dim schSCManager As IntPtr = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_ALL_ACCESS)
    If schSCManager = IntPtr.Zero Then
      'Debug.Print("OpenSCManager failed: " & RaiseAPIErrorByNumber(Err.LastDllError))
      Exit Function
    End If

    ' Get a handle to the service.
    Dim schService As IntPtr = OpenService(schSCManager, ServiceName, SERVICE_CHANGE_CONFIG)
    If schService = IntPtr.Zero Then
      'Debug.Print("OpenService failed: " & RaiseAPIErrorByNumber(Err.LastDllError))
      CloseServiceHandle(schSCManager)
      Exit Function
    End If
    ' Change the service AutoStart
    If ChangeServiceConfig(schService, SERVICE_NO_CHANGE, _
     IIf(bAutoStart, SERVICE_AUTO_START, SERVICE_DEMAND_START), SERVICE_NO_CHANGE) = False Then
      'Debug.Print("ChangeServiceConfig failed: " & RaiseAPIErrorByNumber(Err.LastDllError))
    Else
      'Debug.Print("Service AutoStart successfully changed to " & bAutoStart.ToString)
      SetServiceAutoStart = True
    End If

    CloseServiceHandle(schService)
    CloseServiceHandle(schSCManager)
  End Function

  Public Function GetServiceStartType(ByVal ServiceName As String) As Integer
    ' It returns zero value on error
    'возвращает тип автозапуска: 2-SERVICE_AUTO_START;3-SERVICE_DEMAND_START;4-SERVICE_DISABLED
    Dim hService As IntPtr
    Dim r As Integer, SCfg As QUERY_SERVICE_CONFIG
    Dim pBuffer As IntPtr

    GetServiceStartType = 0
    Dim hSCManager As IntPtr = OpenSCManager(vbNullString, vbNullString, SC_MANAGER_CONNECT)
    If hSCManager <> IntPtr.Zero Then
      hService = OpenService(hSCManager, ServiceName, SERVICE_QUERY_CONFIG)
      If hService <> IntPtr.Zero Then
        If QueryServiceConfig(hService, pBuffer, r, r) = False Then
          If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
            pBuffer = Marshal.AllocHGlobal(r)
            If QueryServiceConfig(hService, pBuffer, r, r) Then
              SCfg = Marshal.PtrToStructure(pBuffer, GetType(QUERY_SERVICE_CONFIG))
              GetServiceStartType = SCfg.dwStartType
            End If
          End If
        End If
        CloseServiceHandle(hService)
      End If
      CloseServiceHandle(hSCManager)
    End If
    If Not pBuffer.Equals(0) Then
      Marshal.FreeHGlobal(pBuffer)
    End If
  End Function

Public Function GetCommonDesktopDirectoryPath() As String
    'Return Environment.GetFolderPath(Environment.SpecialFolder.CommonDesktopDirectory) 'не поддерживается в .Net ниже версии 4
    Return GetSysFolderPath(CSIDL_VALUES.CSIDL_COMMON_DESKTOPDIRECTORY)
  End Function

  Public Function GetCommonProgramsPath() As String
    'Return Environment.GetFolderPath(Environment.SpecialFolder.CommonPrograms) 'не поддерживается в .Net ниже версии 4
    Return GetSysFolderPath(CSIDL_VALUES.CSIDL_COMMON_PROGRAMS)
  End Function

  Public Function GetCommonAdminToolsPath() As String
    'Return Environment.GetFolderPath(Environment.SpecialFolder.CommonAdminTools) 'не поддерживается в .Net ниже версии 4
    Return GetSysFolderPath(CSIDL_VALUES.CSIDL_COMMON_ADMINTOOLS)
  End Function

  Private Function GetSysFolderPath(ByVal CSIDL As CSIDL_VALUES) As String

    GetSysFolderPath = ""

    ' Create buffer for return results.
    Dim buffer As String = Space(MAX_PATH)

    ' Grab requested system folder.
    If SHGetFolderPath(IntPtr.Zero, CSIDL, IntPtr.Zero, SHGFP_TYPE_DEFAULT, buffer) = S_OK Then
      GetSysFolderPath = Strings.Left(buffer, InStr(buffer & vbNullChar, vbNullChar) - 1)
    End If
  End Function