1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208
|
Imports System.DirectoryServices
Imports System.Security.Principal
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Imports System.IO
Imports System.Transactions
Public Class cImport
#Region "Constants, Enum and Declarations"
Private Const LOGON32_LOGON_INTERACTIVE As Integer = 2
Private Const LOGON32_PROVIDER_DEFAULT As Integer = 0
'For acces to a folder with a login different of the session
Declare Auto Function LogonUser Lib "advapi32.dll" (ByVal lpszUsername As String, _
ByVal lpszDomain As String, _
ByVal lpszPassword As String, _
ByVal dwLogonType As Integer, _
ByVal dwLogonProvider As Integer, _
ByRef phToken As IntPtr) As Integer
'For acces to a folder with a login different of the session
Declare Auto Function DuplicateToken Lib "advapi32.dll" (ByVal ExistingTokenHandle As IntPtr, _
ByVal ImpersonationLevel As Integer, _
ByRef DuplicateTokenHandle As IntPtr) As Integer
#End Region
#Region "Members"
Private _ci As System.Globalization.CultureInfo
Private _importDir As String
#End Region
#Region "Constructor"
Public Sub New()
Try
'For manipulating excel
_ci = New System.Globalization.CultureInfo("en-US")
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
End Sub
#End Region
#Region "Methods"
Private Function DirToArray(ByVal sFolder As String, Optional ByVal sFilter As String = "*.*", Optional ByVal bRecurvise As Boolean = True) As String()
Try
'ajoute le dernier "\"
If Not (sFolder(sFolder.Length - 1) = "\"c) Then sFolder &= "\"
'le dossier doit existe
If Not (System.IO.Directory.Exists(sFolder)) Then Return Nothing
'récupère le tableau depuis class framework
If bRecurvise Then
Return System.IO.Directory.GetFiles(sFolder, sFilter, IO.SearchOption.AllDirectories)
Else
Return System.IO.Directory.GetFiles(sFolder, sFilter, IO.SearchOption.TopDirectoryOnly)
End If
Catch ex As Exception
DirToArray = {ex.Message}
End Try
End Function
Private Function DirToList(ByVal sFolder As String, Optional ByVal sFilter As String = "*.*", Optional ByVal bRecurvise As Boolean = True) As List(Of String)
'résultat sous forme de collection de chaîne
Dim ListResult As New List(Of String)
'récupère le tableau
Dim asDir() As String = DirToArray(sFolder, sFilter, bRecurvise)
'intègre dans la liste
If Not (asDir Is Nothing) Then
For Each s As String In asDir
ListResult.Add(s)
Next
End If
Return ListResult
End Function
Private Function ImpersonateValidUser(ByRef impersonationContext As WindowsImpersonationContext, _
ByVal userName As String, _
ByVal domain As String, _
ByVal password As String) As Boolean
Dim tempWindowsIdentity As WindowsIdentity
Dim token As IntPtr
Dim tokenDuplicate As IntPtr
If LogonUser(userName, domain, password, LOGON32_LOGON_INTERACTIVE, _
LOGON32_PROVIDER_DEFAULT, token) <> 0 Then
If DuplicateToken(token, 2, tokenDuplicate) <> 0 Then
tempWindowsIdentity = New WindowsIdentity(tokenDuplicate)
impersonationContext = tempWindowsIdentity.Impersonate()
If impersonationContext Is Nothing Then
ImpersonateValidUser = False
Else
ImpersonateValidUser = True
End If
Else
ImpersonateValidUser = False
End If
Else
ImpersonateValidUser = False
End If
End Function
''' <summary>
''' Import all data in the quality data
''' </summary>
''' <remarks></remarks>
Public Sub Import()
'Variable to manipulate files
Dim impersonationContext As WindowsImpersonationContext = Nothing
Dim oExcel As Excel.Application = Nothing
' Ajoutez une initialisation quelconque après l'appel InitializeComponent().
Try
If Not ImpersonateValidUser(impersonationContext, "NewLogin", "Domain", "MdP") Then Throw New Exception()
'Open Excel
oExcel = New Excel.Application
'Begin importations
ImportNCCAData(oExcel)
undoImpersonation(impersonationContext)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Finally
If Not oExcel Is Nothing Then
oExcel.Workbooks.GetType().InvokeMember("Close", Reflection.BindingFlags.InvokeMethod, Nothing, oExcel.Workbooks, Nothing, _ci)
oExcel.GetType().InvokeMember("Quit", Reflection.BindingFlags.InvokeMethod, Nothing, oExcel, Nothing, _ci)
System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcel)
oExcel = Nothing 'freeing memory
End If
End Try
End Sub
Private Sub ImportNCCAData(ByRef oExcel As Excel.Application)
Try
'Fonctionne
Dim importFiles = DirToList("\\MonRepAuquelJeNAiPasAcces", "*.*", True)
Dim sPluriel = String.Empty
If (importFiles.Count > 1) Then sPluriel = "s"
Console.WriteLine(String.Format("{0} fichier{1} trouvé{1}", importFiles.Count, sPluriel))
For Each s As String In importFiles
Console.WriteLine(s)
Next
Dim oSheet = New Excel.Worksheet
Dim sFile As String = _importDir + "\MonFichier.xls"
Dim sWorkFile As String = _importDir + "\MonFichier_treating.xls"
If Not File.Exists(sFile) Then Exit Sub
If File.Exists(sWorkFile) Then File.Delete(sWorkFile)
File.Copy(sFile, sWorkFile)
'Plante ici.
oExcel.Workbooks.GetType().InvokeMember("Open", Reflection.BindingFlags.InvokeMethod, Nothing, oExcel.Workbooks, {sWorkFile, False, True}, _ci)
'*****
'Taitement d'importation
'*****
'delete the used file
File.Delete("N:\Divers\Quality_Importation\Rapport NCCA BASE QUALITE_20010808_pending.xls")
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical)
Finally
If Not oSheet Is Nothing Then oSheet = Nothing
''Mask progress bar
'frmMenu.Gauge.Visible = False
'frmMenu.lblStatus.Visible = False
'lblProgress.Text = ""
'pbImportGauge.Value = li_StartRow
End Try
End Sub
#End Region |
Partager