Keskustelu: Ohjelmointikysymykset: VB.NET: [VB.Net] Tiedostonimen kelvollisuuden tarkistus

novice [17.02.2010 10:18:41]

Hei.

Onko VB:ssä valmista funktiota jolla voisi tarkistaa onko merkkijono kelvollinen tiedostonimeksi?
Tiedoston luontiyrityksellähän se selviää, mutta...

neau33 [18.02.2010 14:02:17]

Morjens novice!

jos ei ole niin oheisella virityksellä selviää melko pitkälle...

Sub Button1Click(sender As Object, e As EventArgs)

   ' Testi...
   If IsValidFileName(TextBox1.Text) Then
      MsgBox("jeee...")
   Else
      MsgBox("yäää...")
   End If

End Sub

Function IsValidFileName(fName As String) As Boolean

   If fName.Replace(".", "").Trim = String.Empty _
   Or fName.IndexOf("*") > -1 _
   Or fName.IndexOf("?") > -1 _
   Or fName.ToString.Length > 255  Then
      Return False
      Exit Function
   End If

   Dim invalidPathChars As Char() = _
   System.IO.Path.GetInvalidPathChars()

   Dim invalidPChar As Char
   For Each invalidPChar In invalidPathChars
      For i As Integer = 0 To fName.Length -1
         If fName.Substring(i,1) = _
         invalidPChar.ToString Then
            invalidPathChars = Nothing
            Return False
            Exit Function
         End If
      Next
   Next invalidPChar

   Dim DevStr As String = _
   "CLOCK$,AUX,CON,NUL,PRN,COM1," + _
   "COM2,COM3,COM4,COM5,COM6,COM7," + _
   "COM8,COM9,LPT1,LPT2,LPT3,LPT4," + _
   "LPT5,LPT6,LPT7,LPT8,LPT9"

   Dim DevNames() As String = DevStr.Split(",")
   DevStr = Nothing

   For i As Integer = _
   DevNames.GetLowerBound(0) To _
   DevNames.GetUpperBound(0)
      If fName.ToUpper _
      = DevNames(i) Then
         DevNames = Nothing
         Return False
         Exit Function
      End If
   Next

   invalidPathChars = Nothing
   DevNames = Nothing
   Return True

End Function

Nyt jos nappaat esimerkin funktion ClassLibrary-projektiin, käännät projektin .Net assemblyksi, rekisteröit koko roskan (ohjeita löytyy täältä) ja lähetät tuotoksen sitten Microsoftille keralla pyynnön, että liittävät assemblysi seuraavaan .NET framework-pakettiin niin funktio on, riippuen vahvasti heistä of course, sitten käytössä kaikilla .NET kielillä...mikäli vielä hyödynnät ohjeistuksen comvisible attribuuttia niin funkkaria voidaan kutsua myös esim. VB6/VBA ympyröistä käsin jne...

neau33 [19.02.2010 09:42:29]

Morjens taas novice!

here's a bit more advanced version of the shit...

elikäs luo VB:llä uusi ClassLibrary-projekti nimellä PathValidation...nimeä uudelleen Project Explorerissa NewClass.vb nimellä FilePath.vb, tuplaklikkaa samaista kuvaketta & copy/pasteta alla oleva koodi kaiken sen päälle mitä on näkyvissä FilePath.vb'n koodi-ikkunassa...

Imports System.Runtime.InteropServices
<ClassInterface(ClassInterfaceType.AutoDual)> _
<ComVisible(True)> _
<ProgId("PathValidation.FilePath")> _
Public Class FilePath

   <ComVisible(True)> _
   Public Function IsValidPath(fName As string) As Object

      Dim retObj(1) As Object

      retObj(1) = True

      If fName.IndexOf("\") > - 1 Then

         retObj(0) = (Dir(fName.Substring( _
         0, fName.LastIndexOf("\") + 1), _
         Microsoft.VisualBasic.vbDirectory).Length > 0)
         fName = fName.Replace(fName.Substring( _
         0, fName.LastIndexOf("\") + 1),"")

      End If

      If fName.Replace(".", "").Trim = String.Empty _
      Or fName.IndexOf("*") > -1 _
      Or fName.IndexOf("?") > -1 _
      Or fName.IndexOf("/") > -1 _
      Or fName.ToString.Length > 255  Then
         retObj(1) = False
      End If

      If retObj(1) Then
         Dim invalidPathChars As Char() = _
         System.IO.Path.GetInvalidPathChars()
         Dim invalidPChar As Char

         For Each invalidPChar In invalidPathChars
            For i As Integer = 0 To fName.Length -1
               If fName.Substring(i,1) = _
               invalidPChar.ToString Then
                  retObj(1) = False: Exit For
               End If
            Next
         Next invalidPChar

      End If

      If retObj(1) Then

         Dim DevStr As String = _
         "CLOCK$,AUX,CON,NUL,PRN,COM1," + _
         "COM2,COM3,COM4,COM5,COM6,COM7," + _
         "COM8,COM9,LPT1,LPT2,LPT3,LPT4," + _

         Dim DevNames() As String = DevStr.Split(",")
         DevStr = Nothing

         For i As Integer = _
         DevNames.GetLowerBound(0) To _
         DevNames.GetUpperBound(0)
            If fName.ToUpper _
            = DevNames(i) Then
               retObj(1) = False: Exit For
            End If
         Next

      End If

      Return retObj
      retObj = Nothing

   End Function

End Class

valitse valikkoriviltä Project/Project Options...ruksaa Signing-välilehdeltä valinta: Sign the assembly, valitse laatikosta valinta: Create ja klikkaa OK:ta...tarkista vielä Application-välilehdeltä, että Output type on ClassLibrary...tallenna koko projekti...Tuplaklikkaa Project Explorerissa AssemblyInfo.vb kuvaketta ja copy/pasteta alla oleva koodi kaiken AssemblyInfo.vb koodi-ikkunassa näkyvän päälle...

Imports System.Reflection
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices

<assembly: AssemblyTitle("PathValidation")>
<assembly: AssemblyDescription("FileName/Path Validator")>
<assembly: AssemblyConfiguration("")>
<assembly: AssemblyCompany("")>
<assembly: AssemblyProduct("PathValidation")>
<assembly: AssemblyCopyright("Copyright 2010")>
<assembly: AssemblyTrademark("")>
<assembly: AssemblyCulture("")>
<assembly: ComVisible(True)>

'vaihda GUID luomalla oma GUID GuidGen apu-ohjelmalla (Registry Format)
'kopioi leikepöydälle, leikepöydältä hipsujen väliin & poista aaltosulkeet
<assembly: Guid("0F869139-C1B9-4eeb-9AE8-A529DCF38309")>
<assembly: AssemblyVersion("1.0.0.0")>

Tallenna ja käännä projekti...avaa Resurssienhallinta, siirry projektisi ...\Bin\Debug hakemistoon & kopioi OpenFile.dll Windows\System32 -hakemistoon...avaa komentokehote-ikkuna
kirjoita: CD \Windows\System32 & painele Enter-nappia...
kirjoita: TlbExp PathValidation.dll /out: PathValidation.Tlb & painele...
kirjoita: gacgutil /i PathValidation.dll &...
kirjoita: ngen install PathValidation.dll &...
kirjoita: regasm PathValidation.dll &...
and that's it

VB.NET Testiprojekti (WindowsForms):
ValidationTest - MainForm.vb

Imports PathValidation

' formille:
' 2 tekstilootaa (txtFileName & txtTextarea)
' 2 chekcboxia   (chkOverwrite & chkBinary)
' 1 nappi        (btnSave)

Public Partial Class MainForm

   Public Sub New()
        Me.InitializeComponent()
   End Sub

   Sub BtnSaveClick(sender As Object, e As EventArgs)

        'Testi...
        Dim chkFilePath As New _
        PathValidation.FilePath

        If Not chkFilePath.IsValidPath(txtFileName.Text)(0) Is Nothing Then
           If Not chkFilePath.IsValidPath(txtFileName.Text)(0) _
           Or Not chkFilePath.IsValidPath(txtFileName.Text)(1) Then
                MsgBox("Invalid filename or invalid path")
                txtFileName.Text = String.Empty
                chkFilePath = Nothing: Exit Sub
           End If
        Else
             If Not chkFilePath.IsValidPath(txtFileName.Text)(1) Then
                MsgBox("Invalid filename")
                txtFileName.Text = String.Empty
                chkFilePath = Nothing: Exit Sub
             End If
        End If

        chkFilePath = Nothing

        If Dir(txtFileName.Text).Length > 0 Then
           If Not chkOverwrite.Checked Then
                Dim msgresult As Integer = _
                msgbox("File '" + txtFileName.Text + _
                "' already exists" + Environment.NewLine + _
                "Do you want to overwrite?", _
                MsgBoxStyle.YesNo, "File handler")
                If msgresult = 7
                   txtFileName.Text = String.Empty
                   Exit Sub
                End If
           Else
                FileSystem.Kill(txtFileName.Text)
           End If
        End If

        'esim.
        Select Case chkBinary.Checked
           Case False
                WriteToFile(txtFilename.Text, txtTextarea.Text)
           Case True
                Dim enc As New System.Text.ASCIIEncoding
                Dim bytes As Byte() = enc.GetBytes(txtTextarea.Text)
                WriteToFile(txtFilename.Text, bytes)
                enc = Nothing: bytes = Nothing
        End Select

   End Sub

   Sub WriteToFile(Byval fName As String, ByVal fObject As Object)

        If TypeOf(fObject) Is System.String Then
           FileSystem.FileOpen(1, fName, _
           OpenMode.Output, OpenAccess.Write)
           FileSystem.Print(1, fObject)
           FileSystem.FileClose(1)
           MsgBox("String has been successfully written")
        ElseIf TypeOf(fObject) Is System.Byte() Then
           FileSystem.FileOpen(1, fName, _
           OpenMode.Binary, OpenAccess.Write)
           FileSystem.FilePutObject(1, fObject)
           FileSystem.FileClose(1)
           MsgBox("Bytes has been successfully written")
      End If

   End Sub

End Class

Excel/VBA Testiprojekti
avaa Excel, valitse Työkalut/Makro/VisualBasic Editor...valitse Tools/References, ruksaa listalta PathValidation (jos ei löydy, klikkaa Browse-nappia ja valitse Windows\System32 hakemistosta PathValidation.Tlb, klikkaa Avaa-nappia & ruksaa listalta) & painele OK:ta
Lisää VBA-Projektiin UserFormi, formille 2 tekstilootaa (txtFileName & txtTextarea), 2 checkboxia (chkOverwrite & chkBinary) 1 nappi (btnSave), tuplaklikkaa nappia ja copy/pasteta alla oleva koodi kokonaisuudessaan napin Click_tapahtuman päälle

Dim chkFilePath As New PathValidation.FilePath

Private Sub btnSave_Click()

   If txtFilename.Text = "" Then
      Beep
      txtFilename.SetFocus
   Else
      CheckFilePath txtFilename.Text
   End If

End Sub

Sub CheckFilePath(ByVal fPath As String)

   If chkFilePath.IsValidPath(fPath)(0) = True _
   And chkFilePath.IsValidPath(fPath)(1) = False Then
      MsgBox ("Invalid filename")
      txtFilename.Text = ""
      Exit Sub
   ElseIf chkFilePath.IsValidPath(fPath)(0) = False _
   And chkFilePath.IsValidPath(fPath)(1) = True Then
      MsgBox ("Invalid pathname")
      txtFilename.Text = ""
         Exit Sub
      ElseIf chkFilePath.IsValidPath(fPath)(0) = False _
      And chkFilePath.IsValidPath(fPath)(1) = False Then
      MsgBox ("Invalid filename and pathname")
      txtFilename.Text = ""
      Exit Sub
   End If

   If Len(Dir(txtFilename.Text)) > 0 Then
      If chkOverwrite.Value = False Then
         Dim msgresult As Integer
         msgresult = MsgBox("File '" & txtFilename.Text & _
         "' already exists" & vbCrLf & _
         "Do you wish to overwrite?", _
         vbYesNo, "File handler")
         If msgresult = 7 Then
            txtFilename.Text = "": Exit Sub
         End If
      Else
         Kill (txtFilename.Text)
      End If
   End If

   Select Case chkBinary.Value
      Case False
         WriteToFile fPath, txtTextarea.Text, 0
      Case True
         Dim bytes() As Byte
         bytes = StrConv(txtTextarea.Text, vbUnicode)
         WriteToFile txtFilename.Text, bytes, 1
   End Select

End Sub

Sub WriteToFile(ByVal fName As String, ByVal fObject As Variant, ByVal mode As Integer)

   Select Case mode
      Case 0
         Open fName For Output As #1
         Print #1, fObject: Close #1
         MsgBox ("String data has been successfully written")
      Case 1
         Open fName For Binary Access Write As #1
         Put #1, , fObject: Close #1
         MsgBox ("Byte data has been successfully written")
   End Select

End Sub

novice [19.02.2010 19:39:44]

Taidan pärjätä tuolla ensimäisellä. Olisin kyllä saanut itsekin aikaiseksi jonkinlaisen funktion (jos vain olisi jaksanut jostain kaivaa nuo rajoitteet).

Kiitos taas nea.

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen