[VBScript] Objekte in Arrays ablegen

[Luckie]

Ich versuche gerade Objekte in einem Array abzulegen und wieder auszulesen. Als Beispiel habe ich Dateien in einem Verzeichnis:

Code:

Set fo = fso.GetFolder(FOLDER)

Set files = fo.Files
i = 0
For Each file in files
  ReDim file_array(i+1)
  file_array(i) = file
  i = i + 1
Next

For i = 0 to ubound(file_array)
  file = file_array(i)
  Filedate = file.DateLastModified
  Filesize = file.Size
  Filename = file.Name
  ts.WriteLine "<tr>"
  ts.WriteLine "<td class='date'>" & Filedate & "</td>"
  ts.WriteLine "<td class='size'>" & Filesize & "</td>"
  ts.WriteLine "<td class='name'>[url='" & fo.Path & "/" & Filename & "']" & Filename & "[/url]</td>"
  ts.WriteLine "</tr>"
Next

In dem Array file_array befinden sich, oder sollten sich befinden, die file-Objekte. Allerdings sagt er mir in der For-Schleife, das er hier: Filedate = file.DateLastModified ein Objekt erwartet. Ein Cast nach Scripting.FileSystemObject.File hat auch nicht geholfen. Wie komme ich also an die Objekte dran?

[Luckie]

Ich muss das noch mal nach oben holen. Ist zwar nicht überlebenswichtig, aber mein Berufsschullehrer meinte, ich solle die Datei-ausgabe mal sortieren, so als Zusatzaufgabe. Dazu wollte ich eben alle Datei-Objekte in einem Array sammeln und dieses Array dann sortieren.

[thkerkmann]

Hi,

ich glaube das geht mit einm solchen Feld nicht. Dafür gibt es das Collection Object, welches wiederum Objekte aufnehmen kann

Code:

  Dim names As New Microsoft.VisualBasic.Collection()

Näheres in der MSDN

Gruss

[Edit]
Oh Mist, ich seh grad du hast ja VBScript geschrieben. Da gibt es die Collection natürlich nicht, sorry.
[/Edit]

[Luckie]

Oder alternativ gibt es eine Klasse die mit der Delphi Klasse TList vergleichbar ist?

[EWeiss]

Hi

ganz oben in den Kopf der Form setzen

Code:

Option Explicit 'Fehlermeldung ausgeben
Private fso As Scripting.FileSystemObject 'object initialisieren

Dazu muss im Menü/Projekt/Verweise erst die Laufzeit Bibliothek 'Microsoft Scripting Runtime' importiert werden.

gruss

[Luckie]

So weit bin ich schon. ;)

Code:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Script        : Verzeichnis in einer HTML-Datei ausgeben                     '
' File          : 04_02_Dir2HTML.vbs                                           '
' Date          : 2007-02-08 - Last modified: 2007-02-08                       '
'                                                                              '
'               Michael Puff - [url]http://www.michael-puff.de[/url]                      '
'                                                                              '
'               Durch ein File-Container Attribut iterieren                    '
'               Erzeugen einer Textdatei                                       '
'               Aufruf des IE-COM Objektes                                     '
'               Funktionsaufrufe                                               '
'               Dynamische Arrays                                              '
'                                                                              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
FOLDER = "D:\Homepage\michael-puff.de\Berufsschule\Anwendungsentwicklung - Johlen\VBScripte"
HTMLFILE = "index.html"
STYLESHEET = "D:\Homepage\michael-puff.de\Berufsschule\Anwendungsentwicklung - Johlen\VBScripte\stylesheet.css"
OUTFOLDER = "D:\Homepage\michael-puff.de\Berufsschule\Anwendungsentwicklung - Johlen\VBScripte"

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
dim file_array()

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Subs
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Page header
private sub HTMLHeader(ts)
  ts.WriteLine "<html>"
  ts.WriteLine "<head><link rel='stylesheet' type='text/css' href='" & STYLESHEET & "'></head>"
  ts.WriteLine "<body>"
end sub

' Page footer
private sub HTMLFooter(ts)
  ts.WriteLine "</body>"
  ts.WriteLine "</html>"
end sub

' BubbleSort
function bubblesort(arrSortieren)
  for i = 0 to ubound(arrSortieren)
    for j = i + 1 to ubound(arrSortieren)
      if arrSortieren(i) > arrSortieren(j) then
        arrTemp = arrSortieren(i)
        arrSortieren(i) = arrSortieren(j)
        arrSortieren(j) = arrTemp
      end if
    next
  next
  bubblesort = arrSortieren
end function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Set fso = CreateObject("Scripting.FileSystemObject")


Set ts = fso.CreateTextFile(OUTFOLDER & HTMLFILE)

HTMLHeader(ts)

Set fo = fso.GetFolder(FOLDER)
title = "Index of " & fo.Path

ts.WriteLine "<h2>" & title & "</h2>

"

ts.WriteLine "<table class='dir'>"
ts.WriteLine "<th class='date'>Last modified</th><th class='size'>Size</th><th class='name'>file name</th>"

Set files = fo.Files
i = 0
ReDim file_array(files.Count)
For Each file in files
  file_array(i) = file
  i = i + 1
Next

For i = 0 to ubound(file_array)
  Set file = file_array(i)
  Filedate = file.DateLastModified
  Filesize = file.Size
  Filename = file.Name
  ts.WriteLine "<tr>"
  ts.WriteLine "<td class='date'>" & Filedate & "</td>"
  ts.WriteLine "<td class='size'>" & Filesize & "</td>"
  ts.WriteLine "<td class='name'>[url='" & fo.Path & "/" & Filename & "']" & Filename & "[/url]</td>"
  ts.WriteLine "</tr>"
Next

ts.WriteLine "<tr><td class='date'>File(s): " & fo.files.Count & "</td></tr>"
ts.WriteLine "</table>"

HTMLFooter(ts)

ts.Close

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Set ie = CreateObject("InternetExplorer.Application.1")
ie.Visible = True
ie.Navigate(OUTFOLDER & HTMLFILE)

Und es ist ein VBS Script und keine Visual Basic Anwendung. Und in Zeile 85 kommt die Fehlermeldung, dass er ein Objekt erwarter, er aber offensichtlich keins bekommt. Irgendwie scheint er also alles andere in dem Array abzulegen nur keon Objekt. :wall:

[EWeiss]

Zitat:

Und es ist ein VBS Script und keine Visual Basic Anwendung

Ist doch das selbe!

Wo ist der unterschied?

Code:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Script        : Verzeichnis in einer HTML-Datei ausgeben                     '
' File          : 04_02_Dir2HTML.vbs                                           '
' Date          : 2007-02-08 - Last modified: 2007-02-08                       '
'                                                                              '
'               Michael Puff - [url]http://www.michael-puff.de[/url]                      '
'                                                                              '
'               Durch ein File-Container Attribut iterieren                    '
'               Erzeugen einer Textdatei                                       '
'               Aufruf des IE-COM Objektes                                     '
'               Funktionsaufrufe                                               '
'               Dynamische Arrays                                              '
'                                                                              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim file_array()
Dim FOLDER As String
Dim HTMLFILE As String
Dim STYLESHEET As String
Dim OUTFOLDER As String

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Subs
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Page header
Private Sub HTMLHeader(ts)
  ts.WriteLine "<html>"
  ts.WriteLine "<head><link rel='stylesheet' type='text/css' href='" & STYLESHEET & "'></head>"
  ts.WriteLine "<body>"
End Sub

' Page footer
Private Sub HTMLFooter(ts)
  ts.WriteLine "</body>"
  ts.WriteLine "</html>"
End Sub

' BubbleSort
Function bubblesort(arrSortieren)
  For i = 0 To UBound(arrSortieren)
    For j = i + 1 To UBound(arrSortieren)
      If arrSortieren(i) > arrSortieren(j) Then
        arrTemp = arrSortieren(i)
        arrSortieren(i) = arrSortieren(j)
        arrSortieren(j) = arrTemp
      End If
    Next
  Next
  bubblesort = arrSortieren
End Function


Private Sub Command1_Click()

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(OUTFOLDER & "\" & HTMLFILE)

Call HTMLHeader(ts)

Set fo = fso.GetFolder(FOLDER)
Title = "Index of " & fo.Path

ts.WriteLine "<h2>" & Title & "</h2>

"

ts.WriteLine "<table class='dir'>"
ts.WriteLine "<th class='date'>Last modified</th><th class='size'>Size</th><th class='name'>file name</th>"

Set Files = fo.Files
i = 0
ReDim file_array(Files.Count)
For Each file In Files
  file_array(i) = file
  i = i + 1
Next

For i = 0 To UBound(file_array)
  Set Files = file_array(i)
  Filedate = file.DateLastModified
  Filesize = file.Size
  FileName = file.Name
  ts.WriteLine "<tr>"
  ts.WriteLine "<td class='date'>" & Filedate & "</td>"
  ts.WriteLine "<td class='size'>" & Filesize & "</td>"
  ts.WriteLine "<td class='name'>[url='" & fo.Path & "/" & FileName & "']" & FileName & "[/url]</td>"
  ts.WriteLine "</tr>"
Next

ts.WriteLine "<tr><td class='date'>File(s): " & fo.Files.Count & "</td></tr>"
ts.WriteLine "</table>"

HTMLFooter (ts)

ts.Close


'Set ie = CreateObject("InternetExplorer.Application.1")
ie.Visible = True
ie.Navigate (OUTFOLDER & HTMLFILE)

End Sub

Private Sub Form_Load()


FOLDER = "D:\Test"
HTMLFILE = "index.html"
STYLESHEET = "D:\Test\stylesheet.css"
OUTFOLDER = "D:\Test"

End Sub

Edit:
Wenn du die zuordnung mit set nicht richtig auf das Object legst dann
gibt es eine nachfrage nach diesen Object 'Fehlermeldung' Object erwartet.

gruss

[Luckie]

Und deins funktioniert? Wo ist der Fehler bei mir?

Bei mir sagt er in Zeile 25: "Anweisungsende erwartet."

[EWeiss]

Zitat:

Zitat von Luckie

Und deins funktioniert? Wo ist der Fehler bei mir?

Bei mir sagt er in Zeile 25: "Anweisungsende erwartet."

Na kann es nicht richtig testen da die stylesheet.css bei mir nicht im Ordner 'Test'
existiert.

gruss

[Luckie]

Der spielt doch keine Rolle. Und wenn er nicht gefunden wird, macht es auch nichts.

[EWeiss]

Zitat:

Zitat von Luckie

Der spielt doch keine Rolle. Und wenn er nicht gefunden wird, macht es auch nichts.

JO sieht dann bescheiden aus...
Dein Fehler liegt hier.

Set file = file_array(i)
Filedate = File.DateLastModified

Auf File kommst du nur über 'Scripting' nicht über Scripting.FileSystemObject
Und Set file = kannst du keinen array zuweisen wenn du vorher das Object nicht auf scripting.File initialisiert hast

EDIT:
für file der Pfad Scripting.File
für Filedate Scripting.File.DateLastModified

gruss

[EWeiss]

Hier ein kleines Beispiel..

Habs unten geschrieben und das hier gelöscht.

gruss

[EWeiss]

Sorry PUSH!

Hier deine Lösung. Warst ja eigentlich nahe dran.

Set Files = fo.Files
i = 0
ReDim file_array(Files.Count)
For Each File In Files
file_array(i) = File
i = i + 1
Next

Set File = fo.Files
For Each File In fo.Files
//Set Files = file_array(i)
Filedate = File.DateLastModified
Filesize = File.Size
FileName = File.Name
ts.WriteLine "<tr>"
ts.WriteLine "<td class='date'>" & Filedate & "</td>"
ts.WriteLine "<td class='size'>" & Filesize & "</td>"
ts.WriteLine "<td class='name'>" & FileName & "</td>"
ts.WriteLine "</tr>"
Next

Das ist falsch //Set Files = file_array(i)

Wenn es dir Hauptsächlich um das Array geht dann mach es so.

Code:

i = 0
ReDim file_array(Files.Count)
For Each File In Files
  file_array(i) = File & "," & File.DateLastModified & "," & File.Size & "," & File.Name
  i = i + 1
Next

Du mußt das Array dann nur mit dem Delemiter "," spliten dann hast du was du brauchst.

Code:

For i = 0 To UBound(file_array) - 1
  s = Split(file_array(i), ",", -1, vbTextCompare)
  Filedate = s(1)
  Filesize = s(2)
  FileName = s(3)
  ts.WriteLine "<tr>"
  ts.WriteLine "<td class='date'>" & Filedate & "</td>"
  ts.WriteLine "<td class='size'>" & Filesize & "</td>"
  ts.WriteLine "<td class='name'>[url='" & fo.Path & "/" & FileName & "']" & FileName & "[/url]</td>"
  ts.WriteLine "</tr>"
Next

Das Object selbst kannst du nicht in ein array mit einbinden nur den Wert.

gruss Emil

[Luckie]

Zitat:

Zitat von EWeiss

Das Object selbst kannst du nicht in ein array mit einbinden nur den Wert.

OK, darum ging es mir, ich kann also keine Objekte in einem Array ablegen. Ich wollte das Array dann ein eine Funktion übergeben, die esmir dann sortiert.

Ich habe es jetzt so gemacht:

Code:

' BubbleSort
function bubblesort(arrsort)
  for i = 0 to ubound(arrsort) - 1
    for j = i + 1 to ubound(arrsort) - 1
      s1 = Split(arrsort(i), ",", -1, vbTextCompare)
      filesize1 = s1(2)
      s2 = Split(arrsort(j), ",", -1, vbTextCompare)
      filesize2 = s2(2)
      if filesize1 < filesize2 then
        arrTemp = arrsort(i)
        arrsort(i) = arrsort(j)
        arrsort(j) = arrTemp
      end if
    next
  next
  bubblesort = arrsort
end function
'...

Set files = fo.Files
i = 0
ReDim file_array(files.Count)
For Each file In files
  file_array(i) = file & "," & file.DateLastModified & "," & file.Size & "," & file.Name
  i = i + 1 
Next

ReDim sortedarray(files.Count)
sortedarray = bubblesort(file_array)

For i = 0 To ubound(sortedarray) - 1
  s = Split(sortedarray(i), ",", -1, vbTextCompare)
  Filedate = s(1) 
  Filesize = s(2) 
  Filename = s(3)
  ts.WriteLine "<tr>" 
  ts.WriteLine "<td class='date'>" & Filedate & "</td>" 
  ts.WriteLine "<td class='size'>" & Filesize & "</td>" 
  ts.WriteLine "<td class='name'>[url='" & fo.Path & "/" & FileName & "']" & Filename & "[/url]</td>"
  ts.WriteLine "</tr>" 
Next

In Zeile 29 bekomme ich jetzt den Fehler: "Typen unverträglich". Warum denn das? Es sind doch beides Arrays? Desweiteren scheint er nicht zu sortieren, sondern eigentlich nur das Array durcheinander zu würfeln, als ich es mir mal zur Kontrolle haben ausgeben lassen in der Funktion bubblesort selber.

[EWeiss]

Hi Michael

Hier ist das beispiel von dir.
Schau mal rein ...

Läuft alles einwandfrei bei mir.
Zum testen mußt du einen Ordner Test auf D:\ erstellen im Rootpfad.

Mit Source ;) von dir.

gruss Emil

[Luckie]

Wo liegt den bei mir der Fehler, dass es nicht läuft? Ich sehe da irgendwie keinen Unterschied.

Im Anhang mal mein Code als vbs Script-Datei.

PS: Bei dir wird es auch nicht richtig sortiert.

[EWeiss]

PUSH ist ja spät! ;)

Hier ein Pic!
So richtig sortiert da aber nix.

Nach was soll er denn sortieren.

gruß

[Luckie]

Verdammt, warum läuft das bei dir, aber bei mir nicht? :wall: Sortiert werden soll nach der Dateigröße.

[EWeiss]

Zitat:

Zitat von Luckie

Verdammt, warum läuft das bei dir, aber bei mir nicht? :wall: Sortiert werden soll nach der Dateigröße.

Werd nachher mal schauen muss jetzt ins Bett :oops:
Habe jetzt auch mein Scripting bei den Diensten deaktiviert muss das erst einschalten.

gruss Emil

[Luckie]

Besten Dank. Ich gehe jetzt auch erstmal ins Bett. Guten Nacht.

[EWeiss]

Hier ist die lösung ...
War im grunde alles richtig dein Problem war die convertierung
Einen String kannst du nicht mit BubbleSort(dein algo) vergleichen oder geht das in Delphi ?

Code:

Function BubbleSort(arrsort)
Dim i, j, k
Dim s1, s2, s
Dim filesize1, filesize2
Dim temp
  For i = 0 To UBound(arrsort) - 1
    For j = i + 1 To UBound(arrsort) - 1
      s1 = Split(arrsort(i), ",", -1, vbTextCompare)
      filesize1 = CLng(s1(2)) '// <<<---- war Fehler muß ein CLng davor
      s2 = Split(arrsort(j), ",", -1, vbTextCompare)
      filesize2 = CLng(s2(2)) '// <<<---- war Fehler muß ein CLng davor
      If filesize1 < filesize2 Then
        temp = arrsort(i)
        arrsort(i) = arrsort(j)
        arrsort(j) = temp
      End If
    Next
  Next
  For k = 0 To UBound(arrsort) - 1
    s = Split(arrsort(k), ",", -1, vbTextCompare)
    'MsgBox s(2)
  Next
  BubbleSort = arrsort
End Function

gruss Emil

[Luckie]

Autsch. Nie muss man bei VBScript auf den Datentyp achten und dann so was. :wall:

Besten Dank für deine Hilfe.

[EWeiss]

Zitat:

Zitat von Luckie

Autsch. Nie muss man bei VBScript auf den Datentyp achten und dann so was. :wall:

Besten Dank für deine Hilfe.

Ja gern getan ;)
Bekomme die ja hier auch

Gruss Emil