by
20. dicembre 2008 12.19
Sembra banale, ma a volte la semplice copia dei file e delle sottodirectory contenute in una cartella può mettere in crisi un programmatore, proprio per la sua banalità.
Proprio per evitare questo, posto un esempio di copia ricorsiva.
Private Sub Copia(ByVal PathOrigine As String, _
ByVal PathDestinazione As String)
Dim Files() As String
If PathDestinazione.Chars(PathDestinazione.Length - 1) <>
Path.DirectorySeparatorChar Then
PathDestinazione += Path.DirectorySeparatorChar
End If
If Not Directory.Exists(PathDestinazione) Then
Directory.CreateDirectory(PathDestinazione)
End If
Files = Directory.GetFileSystemEntries(PathOrigine)
Dim Elemento As String
For Each Elemento In Files
'Sotto cartelle
If Directory.Exists(Elemento) Then
Copia(Elemento, PathDestinazione +
Path.GetFileName(Elemento))
' File nella cartella
Else
File.Copy(Elemento, PathDestinazione +
Path.GetFileName(Elemento), True)
End If
Next Elemento
End Sub
by
20. dicembre 2008 12.16
Routine di scompattazione di un file Zip con l'utilizzo della dll rilasciata da ICSharpCode (IC#Code), open source, che si chiama SharpZipLib (#ZipLib) scaricabile liberamente QUI
Imports ICSharpCode.SharpZipLib.Zip
......
If File.Exists(fileName) Then
destPath = fileName.Substring(0, fileName.Length - 4)
If Not Directory.Exists(destPath) Then
Directory.CreateDirectory(destPath)
Else
For Each s As String In Directory.GetFiles(destPath)
File.Delete(s)
Next
End If
Dim inStream As New ZipInputStream(File.OpenRead(fileName))
Dim outStream As FileStream
Dim entry As ZipEntry
Dim buff(2047) As Byte
Dim bytes As Integer
Do While True
Try
entry = inStream.GetNextEntry()
If entry Is Nothing Then
Exit Do
End If
If entry.Name.Last() = "/" Then
Directory.CreateDirectory(destPath & "\" & _
entry.Name.Replace("/", "\"))
Else
Try
outStream = File.Create(destPath & _
"\" & entry.Name, 2048)
Do While True
bytes = inStream.Read(buff, 0, 2048)
If bytes = 0 Then
Exit Do
End If
outStream.Write(buff, 0, bytes)
Loop
outStream.Close()
Catch
End Try
End If
Catch ex As ZipException
rtn += ex.Message & vbCrLf
End Try
Loop
inStream.Close()
Else
rtn = "File '" & fileName & "' non trovato."
End If
a61845e3-75f4-4a9e-adb2-4385d30524ea|2|4.5
Tags: vb.net, codice
by
20. dicembre 2008 12.14
Le funzioni sotto riportate permettono di effettuare da codice una query con "Select Distinct" su un DataSet.
FieldNames è un array di string con in campi su cui fare la select distinct.
Public Function SelectDistinct(ByVal SourceTable As DataTable, _
ByVal ParamArray FieldNames() As String) As DataTable
Dim lastValues() As Object
Dim newTable As DataTable
If FieldNames Is Nothing OrElse FieldNames.Length = 0 Then
Throw New ArgumentNullException("FieldNames")
End If
lastValues = New Object(FieldNames.Length - 1) {}
newTable = New DataTable
For Each field As String In FieldNames
newTable.Columns.Add(field, SourceTable.Columns(field).DataType)
Next
For Each Row As DataRow In SourceTable.Select("",String.Join(", ", FieldNames))
If Not fieldValuesAreEqual(lastValues, Row, FieldNames)Then
newTable.Rows.Add(createRowClone(Row, newTable.NewRow(), FieldNames))
setLastValues(lastValues, Row, FieldNames)
End If
Next
Return newTable
End Function
Private Function fieldValuesAreEqual(ByVal lastValues() As Object, _
ByVal currentRow As DataRow, ByVal fieldNames() As String) As Boolean
Dim areEqual As Boolean = True
For i As Integer = 0 To fieldNames.Length - 1
If lastValues(i) Is Nothing OrElse NotlastValues(i).Equals(currentRow(fieldNames(i))) Then
areEqual = False
Exit For
End If
Next
Return areEqual
End Function
Private Function createRowClone(ByVal sourceRow As DataRow, _
ByVal newRow As DataRow, ByVal fieldNames() As String) AsDataRow
For Each field As String In fieldNames
newRow(field) = sourceRow(field)
Next
Return newRow
End Function
Private Shared Sub setLastValues(ByVal lastValues() As Object, _
ByVal sourceRow As DataRow, ByVal fieldNames() As String)
For i As Integer = 0 To fieldNames.Length - 1
lastValues(i) = sourceRow(fieldNames(i))
Next
End Sub
8a106a1e-1b26-4f58-8a84-3a1fd39a4ca9|0|.0
Tags: codice, vb.net
by
20. dicembre 2008 12.13
A volte può capitare di dover utilizzare la funzioneResponse.Redirect in un UpdatePanel... Spesso, però, questa funzione restituisce un errore. Questo (di solito) significa che in manca una parte della configurazione nel file web.config
Basterà infatti aggiungere
<httpModules>
<add name="ScriptModule"type="System.Web.Handlers.ScriptModule, System.Web.Extensions, Version=1.0.61025.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35"/>
</httpModules>
e tutto funzionerà.
81026236-a20e-4137-8ba8-0b4d7e93e568|0|.0
Tags: ajax, asp.net
by
7. agosto 2008 09.35
Lavorando spesso con gli Uniqueidentifier (noti anche come GUID) avevo la necessità di sapere in qualche modo se la stringa passata ad una funzione fosse effettivamente un GUID oppure qualcosa di diverso. Non trovando una funzione predefinita che lo facesse, me ne sono costruito una utilizzando le Regular Expression:
Public Function IsGUID(ByVal guid As String) As Boolean
Dim rtn As Boolean = False
If Not String.IsNullOrEmpty(guid) Then
Dim guidRegEx As Regex = New Regex("^(\{{0,1}" & _
"([0-9a-fA-F]){8}-([0-9a-fA-F])" & _
"{4}-([0-9a-fA-F]){4}-([0-9a-fA-F]){4}-" & _
"([0-9a-fA-F]){12}\}{0,1})$")
rtn = guidRegEx.IsMatch(guid)
Else
rtn = False
End If
Return rtn
End Function
54d32b98-b0bb-46aa-b928-c78c99b222d3|0|.0
Tags: vb.net, regex
Sottoscrivi