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 |
