Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Dateien eines Ordners auslesen und in eine HTML-Datei schreiben

Frage Entwicklung VB for Applications

Mitglied: Gurkenhobel

Gurkenhobel (Level 1) - Jetzt verbinden

22.08.2013 um 15:23 Uhr, 2356 Aufrufe, 14 Kommentare

Hallo Freunde,
wieder einmal stehe ich mit meinen Nano-Programmierkenntnissen auf dem Schlauch und würde mich über Hilfe sehr freuen.
Und zwar möchte ich mit einem Script aus allen db-Dateien (Extension .db) eines Ordners Strings extrahieren, die immer an der gleichen Position (Dateianfang) der Binärdateien positioniert sind. Diese Strings sollen dann zeilenweise in eine Galeriedatei für jeden Ordner geschrieben werden (HTML-Format).
Der zeilenweise Satzaufbau innerhalb dieser HTML-Datei sollte recht einfach sein: Thumbnail mit Link zur Originalbilddatei | Name der Trägerdatei mit Link zur Originalbilddatei. Die Trägerdatei ist die oben erwähnte Binärdatei mit Angabe des Thumbnail-Links, der Link des Originalbildes wird aus dem Thumbnail-Link gebildet.

Ich habe zwei Scripte zusammengebastelt, aber die sind in Visual Basic. Ich besitze kein Visual Basic, muß das Script also aus dem Microsoft Office (2003) als VBA-Anwendung starten. Den Pfad der Trägerdatei gebe ich über eine Inputbox ein und erhalte auch das gewünschte Ergebnis, aber für fast 100 Dateien pro Ordner ist das doch sehr mühselig und ich suche nach einer Automatisation.

Hier nun der Code:
01.
Sub Extraktor() 
02.
Dateiname = InputBox("Geben Sie den Dateinamen - mit Pfad - an") 
03.
sBuffer = FileRead(Dateiname) 
04.
Set objFSO = CreateObject("Scripting.FileSystemObject") 
05.
Set objFile = objFSO.CreateTextFile(Dateiname & ".html") 
06.
sBuffer = FileRead(Dateiname, 13, 111) ' Thumbnailbild 
07.
lBuffer = Left(sBuffer, 99) & ".jpg"   ' Originalbild 
08.
objFile.Write "<html>" & vbCrLf & "<a href=" & lBuffer & ">" & "<img src=" & sBuffer & "><br>" & Dateiname & "<br></img></a><br>" & vbCrLf 
09.
' Erstellt folgende HTML-Zeile: <a href=Originalbild.jpg><img src=Thumbnailbild><br>Trägerdateiname<br></img></a><br> 
10.
objFile.Write "</html>" 
11.
MsgBox sBuffer 
12.
objFile.Close 
13.
End Sub 
14.
 
15.
Function FileRead(ByVal sFile As String, _ 
16.
  Optional ByVal nStartPos As Long = 1, _ 
17.
  Optional ByVal nBytesToRead As Long = 0) As String 
18.
' (C) Dietmar Otter | vbarchiv.net 
19.
  Dim F As Integer 
20.
  Dim nFileLen As Long 
21.
  Dim sBuffer As String 
22.
  
23.
  ' Datei im Binary-Mode öffnen 
24.
  F = FreeFile 
25.
  Open sFile For Binary As #F 
26.
  
27.
  ' Dateigröße in Bytes 
28.
  nFileLen = LOF(F) 
29.
  
30.
  ' Falls "BytesToRead" nicht angegeben oder 0, 
31.
  ' gesamten Inhalt ab "StartPos" auslesen 
32.
  If nBytesToRead = 0 Then nBytesToRead = nFileLen 
33.
  
34.
  ' Falls StartPos < 1, Bytes rückwärts vom 
35.
  ' Dateiende auslesen 
36.
  If nStartPos < 1 Then 
37.
    nStartPos = nFileLen 
38.
    nBytesToRead = -Abs(nBytesToRead) 
39.
  End If 
40.
  
41.
  ' Falls "StartPos" > Dateigröße und 
42.
  ' "BytesToRead" < 0, Funktion beenden 
43.
  If nStartPos > nFileLen And nBytesToRead < 0 Then 
44.
    Close #F 
45.
    Exit Function 
46.
  End If 
47.
  
48.
  ' Leseposition ermitteln 
49.
  If nBytesToRead < 1 Then 
50.
    nBytesToRead = Abs(nBytesToRead) 
51.
    nStartPos = nStartPos - nBytesToRead + 1 
52.
    If nStartPos < 1 Then 
53.
      nBytesToRead = nBytesToRead - Abs(nStartPos) - 1 
54.
      nStartPos = 1 
55.
    End If 
56.
  End If 
57.
  
58.
  If nStartPos + nBytesToRead - 1 > nFileLen Then 
59.
    nBytesToRead = nFileLen - nStartPos + 1 
60.
  End If 
61.
  
62.
  ' Inhalt auslesen 
63.
  sBuffer = Space$(nBytesToRead) 
64.
  Seek #F, nStartPos 
65.
  Get #F, , sBuffer 
66.
  
67.
  ' Datei schließen 
68.
  Close #F 
69.
  
70.
  FileRead = sBuffer 
71.
End Function
Mein Anliegen wäre also:

  1. Durchlaufen der Extraktor-Schleife für alle *.db-Trägerdateien (Endung db) im jeweiligen Ordner.
  2. Portierung des Codes zu Visual Basic Script (VBS), um nicht immer über das MS Office starten zu müssen.
Ich danke ersteinmal für die Mühe und bin gespannt auf Eure Antworten

Mike
Mitglied: bastla
22.08.2013 um 16:50 Uhr
Hallo Gurkenhobel!
Ich besitze kein Visual Basic
Das besitzt Microsoft - eine Lizenz könntest Du aber bekommen: http://www.microsoft.com/visualstudio/eng/downloads#d-2012-express

Die Schleife sollte keine große Sache sein - ungetestet etwa so:
01.
Sub Extraktor() 
02.
Pfad = "D:\Dein Pfad" 
03.
Set objFSO = CreateObject("Scripting.FileSystemObject") 
04.
For Each Dateiname In objFSO.GetFolder(Pfad).Files 
05.
    sBuffer = FileRead(Dateiname) 
06.
    Set objFile = objFSO.CreateTextFile(Dateiname & ".html") 
07.
    sBuffer = FileRead(Dateiname, 13, 111) ' Thumbnailbild 
08.
    lBuffer = Left(sBuffer, 99) & ".jpg"   ' Originalbild 
09.
    objFile.Write "<html>" & vbCrLf & "<a href=" & lBuffer & ">" & "<img src=" & sBuffer & "><br>" & Dateiname & "<br></img></a><br>" & vbCrLf 
10.
    ' Erstellt folgende HTML-Zeile: <a href=Originalbild.jpg><img src=Thumbnailbild><br>Trägerdateiname<br></img></a><br> 
11.
    objFile.Write "</html>" 
12.
    MsgBox sBuffer 
13.
    objFile.Close 
14.
Next 
15.
End Sub
Hinsichtlich der Portierung: VBS unterstützt nativ keine Binär-Dateien - Workarounds gibt es aber (zB von didi1954 hier) gezeigt ...

Grüße
bastla
Bitte warten ..
Mitglied: Gurkenhobel
22.08.2013 um 17:38 Uhr
Hallo bastla,
danke für die schnelle Antwort. Ja das Schreiben der HTML-Dateien klappt ganz gut. Aber eigentlich wollte ich ja eine "Galeriedatei" haben, in der die einzelnen Links der Thumbnails und Originalbilder gespeichert sind, zeilenweise etwa so:
01.
'  HTML-Zeile: <a href=Originalbild.jpg><img src=Thumbnailbild><br>Trägerdateiname<br></img></a><br> 


Ich hatte da eher an so etas gedacht
01.
Sub Versuch() 
02.
Pfad = "I:\MeinPfad" 
03.
Set objFSO = CreateObject("Scripting.FileSystemObject") 
04.
Set objAusgabe = objFSO.CreateTextFile("Galerie.html") ' die soll erstellt werden ... 
05.
For Each Dateiname In objFSO.GetFolder(Pfad).Files 
06.
    sBuffer = FileRead(Dateiname, 13, 111) ' Thumbnailbild 
07.
    lBuffer = Left(sBuffer, 99) & ".jpg"   ' Originalbild 
08.
    objAusgabe.Write sBuffer & vbTab & lBuffer & vbTab & Dateiname & vbCrLf ' vereinfachte Ausgabe als Text 
09.
      Next 
10.
    objAusgabe.Close 
11.
End Sub
Was aber nicht funktioniert...

Schade, daß man nicht portieren kann, VB werde ich mir wohl nicht zulegen. Ich muss eh nur Textmanipulationen und Dateioperationen ausführen, da genügt VBS.
Bitte warten ..
Mitglied: bastla
22.08.2013 um 18:18 Uhr
Hallo Gurkenhobel!
Schade, daß man nicht portieren kann
Hast Du Dir denn den oben verlinkten Beitrag angesehen?

Grüße
bastla
Bitte warten ..
Mitglied: Gurkenhobel
22.08.2013 um 18:44 Uhr
Hallo bastla,

Hast Du Dir denn den oben verlinkten
[http://www.administrator.de/forum/windows-scriptsprache-mit-bin%C3%A4rdatei-funktionalit%C3%A4t-153166.html#comment-604750
Beitrag] angesehen?

angeschaut schon, aber net so richtig begriffen...
Grüße
Mike
Bitte warten ..
Mitglied: bastla
22.08.2013 um 19:04 Uhr
Hallo Gurkenhobel!

Alternative: Read and write binary file in VBscript

Grüße
bastla
Bitte warten ..
Mitglied: Gurkenhobel
22.08.2013, aktualisiert 25.08.2013
Hallo bastla,

das sieht schon begreiflicher aus. Werde es ab Morgen mal versuchen...
Das Makro Versuch von 17:38 läuft aber immer noch nicht so wie gewollt..

Edit: 25.08.2013 - Aus dem MS Office heraus habe ich das Makro Versuch zum Laufen gebracht...

Grüße
Mike
Bitte warten ..
Mitglied: Gurkenhobel
25.08.2013 um 16:41 Uhr
Hallo,

Ich habe mich nun doch für die Lösung von 76109 entscheiden.
Allerdings vorerst nur zur Probe, denn ich muss jede Datei einzeln eingeben, aus der dann die Bytes 12 bis 99 ausgelesen und in eine Datei mit gleichem Präfix (Name vor dem Punkt) geschrieben werden. Leider läßt sich beim Binären Lesen und Schreiben kein zusätzlicher Text unterbringen. So daß man wohl die Datei erst schließen muss und erst dann weiter bearbeiten kann.

Außerdem suche ich nach einer Lösung, wie man das Ganze automatisiert für jeden Ordner erledigen kann. Es soll jede Datei mit der Endung ".D" in einer Galerie- oder Indexdatei eingetragen werden.

Mein Script nach Windows-Scriptsprache mit Binärdatei-Funktionalität ?:

01.
TestFile=Inputbox("Bitte geben Sie die Trägerdatei an","Trägerdatei mit Link auslesen") 
02.
 
03.
BinFile = Left(TestFile, Len(TestFile)-2) & ".html" 
04.
 
05.
Const Anfang = 12 
06.
Const Ende = 99 
07.
 
08.
Const adTypeBinary = 1 
09.
Const adSaveCreateOverWrite = 2 
10.
 
11.
Dim Fso, File, BinStream, TextStream, BinArray, i 
12.
     
13.
Set Fso = CreateObject("Scripting.FileSystemObject") 
14.
Set File = Fso.OPenTextFile(TestFile) 
15.
Set BinStream = CreateObject("ADODB.Stream") 
16.
     
17.
With BinStream 
18.
'Schritt 5 (Trägerdatei einlesen) 
19.
'TestFile ab Position SkipKopf bis SkipFuss in Byte-Array einlesen 
20.
.Type = adTypeBinary 
21.
 .Open 
22.
 .LoadFromFile TestFile 
23.
 .Position = Anfang  
24.
  BinArray = .Read(Anfang + Ende) 
25.
 .Close 
26.
  
27.
'Schritt 7 (BinFile schreiben) 
28.
 .Open 
29.
 .write BinArray 
30.
 .SaveToFile BinFile, adSaveCreateOverWrite 
31.
 .Close 
32.
End With
Grüße
Mike
Bitte warten ..
Mitglied: bastla
25.08.2013, aktualisiert um 18:04 Uhr
Hallo Gurkenhobel!
wie man das Ganze automatisiert für jeden Ordner erledigen kann
... ist im Prinzip oben schon gezeigt - wenn Du nicht das jeweilige Datei-Objekt, sondern dessen Pfad benötigst, kannst Du ja
01.
For Each Datei In objFSO.GetFolder(Pfad).Files 
02.
    TestFile = Datei.Path
verwenden ...

Dateiname (ohne Extension) und Extension bekommst Du übrigens so:
01.
TestFileName = objFSO.GetBaseName(Datei.Path) 
02.
TestFileExt = objFSO.GetExtensionName(Datei.Path)
Grüße
bastla
Bitte warten ..
Mitglied: Gurkenhobel
25.08.2013 um 18:53 Uhr
Hallo Bastla,
mit dem Code
01.
Set objFso = CreateObject("Scripting.FileSystemObject") 
02.
Pfad="c:\Users\Michael\Documents\Webshots\.cachedir\data7\f" 
03.
Const Anfang = 12 
04.
Const Ende = 99 
05.
Const adTypeBinary = 1 
06.
Const adSaveCreateOverWrite = 2 
07.
 
08.
For Each Datei In objFSO.GetFolder(Pfad).Files  
09.
TestFile = Datei.Path 
10.
 
11.
Dim Fso, File, BinStream, TextStream, BinArray, i 
12.
     
13.
' Set File = Fso.OpenTextFile(Datei) 
14.
BinFile = Left(TestFile, Len(TestFile)-2) & ".html" 
15.
 
16.
Set BinStream = CreateObject("ADODB.Stream") 
17.
With Bitstream... 
18.
 
wird nun für jede .D-Datei ein .HTML-Pendant geschrieben. Wie kommen nun alle Dateinamen in eine Liste (Indexdatei) und wie kann man dort noch zusätzlichen Text (z.B. HTML-Tags) unterbringen ??

Danke ersteinmal
Mike
Bitte warten ..
Mitglied: bastla
25.08.2013 um 19:17 Uhr
Hallo Gurkenhobel!
Wie kommen nun alle Dateinamen in eine Liste (Indexdatei)
Indem Du sie hineinschreiben lässt? Wenn Du die Indexdatei vor der Schleife als Objekt erstellst (wie das syntaktisch geht, findest Du ja schon ganz oben in Zeile 5 Deines eigenen Entwurfs), kannst Du sie innerhalb der Schleife mit den entsprechenden Zeilen befüllen (analog zur Zeile 8) ...

Grüße
bastla
Bitte warten ..
Mitglied: Gurkenhobel
25.08.2013 um 20:14 Uhr
Hallo Bastla,
der erste Test mißlang: Fehler in Zeile 31
01.
... 
02.
Set objAusgabe = objFSO.CreateTextFile("index.html") ' die soll erstellt werden  
03.
 
04.
For Each Datei In objFSO.GetFolder(Pfad).Files  
05.
TestFile = Datei.Path 
06.
 
07.
Dim Fso, File, BinStream, TextStream, BinArray, i 
08.
     
09.
' Set File = Fso.OpenTextFile(Datei) 
10.
BinFile = Left(TestFile, Len(TestFile)-2) & ".html" 
11.
 
12.
Set BinStream = CreateObject("ADODB.Stream") 
13.
     
14.
With BinStream 
15.
'Schritt 5 (Trägerdatei einlesen) 
16.
'TestFile ab Position SkipKopf bis SkipFuss in Byte-Array einlesen 
17.
.Type = adTypeBinary 
18.
 .Open 
19.
 .LoadFromFile TestFile 
20.
 .Position = SkipKopf  
21.
  BinArray = .Read(SkipKopf + SkipFuss) 
22.
 .Close 
23.
  
24.
'Schritt 7 (BinFile schreiben) 
25.
 .Open 
26.
 .write BinArray 
27.
 .SaveToFile BinFile, adSaveCreateOverWrite 
28.
 .Close 
29.
End With 
30.
 
31.
objAusgabe.Write BinStream.BinArray '<-Fehler Argumente vom falschen Typ|außerhalb des Gültigkeitsbereichs|miteinander unvereinbar 
32.
 
33.
Next 
34.
 
35.
objAusgabe.close
Ich mach jetzt ersteinmal Schluß - Buliseiruf geht gleich los. Schön' Aband und Grüße
Mike
Bitte warten ..
Mitglied: bastla
25.08.2013, aktualisiert um 20:34 Uhr
Hallo Gurkenhobel!

Das Schreiben mittels "FileSystemObject" ist für reine Textdateien gedacht - so hätte ich auch Deine Absicht
Diese Strings sollen dann zeilenweise in eine Galeriedatei für jeden Ordner geschrieben werden (HTML-Format).
(als zusätzliche Dateiliste) interpretiert; ansonsten musst Du natürlich bei der Binärdatei-Variante bleiben und versuchen, Deine Textbestandteile vor dem Schreiben passend in die Variable "BinArray" einzubauen ...

Grüße
bastla
Bitte warten ..
Mitglied: Gurkenhobel
26.08.2013, aktualisiert um 15:58 Uhr
Hallo bastla,

Leider komme über einen Typenkonflikt nicht hinaus....
Schade, daß ich mir als Bloody Beginner in VBS die Scriptteile mühselig zusammen"bastla"n muss.
Wie kann ich denn nun die Textbestandteile in das "BinArray" einbinden ?

Geht es damit ?
01.
Function SaveBinaryDataTextStream(FileName, ByteArray) 
02.
  'Create FileSystemObject object 
03.
  Dim FS: Set FS = CreateObject("Scripting.FileSystemObject") 
04.
   
05.
  'Create text stream object 
06.
  Dim TextStream 
07.
  Set TextStream = FS.CreateTextFile(FileName) 
08.
   
09.
  'Convert binary data To text And write them To the file 
10.
  TextStream.Write Stream_BinaryToString(ByteArray) 
11.
End Function 
12.
 
13.
'BinaryToString Function 
14.
'2003 Antonin Foller, http://www.motobit.com 
15.
'Binary - VT_UI1 | VT_ARRAY data To convert To a string  
16.
'CharSet - charset of the source binary data - default is "us-ascii" 
17.
Function Stream_BinaryToString(Binary, CharSet) 
18.
  Const adTypeText = 2 
19.
  Const adTypeBinary = 1 
20.
   
21.
  'Create Stream object 
22.
  Dim BinaryStream 'As New Stream 
23.
  Set BinaryStream = CreateObject("ADODB.Stream") 
24.
   
25.
  'Specify stream type - we want To save text/string data. 
26.
  BinaryStream.Type = adTypeBinary 
27.
   
28.
  'Open the stream And write text/string data To the object 
29.
  BinaryStream.Open 
30.
  BinaryStream.Write Binary 
31.
     
32.
  'Change stream type To binary 
33.
  BinaryStream.Position = 0 
34.
  BinaryStream.Type = adTypeText 
35.
   
36.
  'Specify charset For the source text (unicode) data. 
37.
  If Len(CharSet) > 0 Then 
38.
    BinaryStream.CharSet = CharSet 
39.
  Else 
40.
    BinaryStream.CharSet = "us-ascii" 
41.
  End If 
42.
   
43.
  'Open the stream And get binary data from the object 
44.
  Stream_BinaryToString = BinaryStream.ReadText 
45.
End Function
Grüße
Micha
Bitte warten ..
Mitglied: bastla
26.08.2013 um 18:08 Uhr
Hallo Gurkenhobel!

Das sollte wohl in die andere Richtung ("StringToBinary") gehen ...

Grüße
bastla
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(8)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Batch & Shell
gelöst 2 große TXT Dateien vergleichen und Unterschiede in andere Datei schreiben (6)

Frage von sid.pdm zum Thema Batch & Shell ...

Windows Systemdateien
gelöst Registry-Schlüssel per Batch auslesen und in Datei schreiben (9)

Frage von Philzip zum Thema Windows Systemdateien ...

HTML
gelöst Mit HTML Datei eine Textdatei auslesen (7)

Frage von Maffi zum Thema HTML ...

Heiß diskutierte Inhalte
Microsoft
Ordner mit LW-Buchstaben versehen und benennen (21)

Frage von Xaero1982 zum Thema Microsoft ...

Windows Update
Treiberinstallation durch Windows Update läßt sich nicht verhindern (17)

Frage von liquidbase zum Thema Windows Update ...

Windows Tools
gelöst Aussendienst Datensynchronisierung (12)

Frage von lighningcrow zum Thema Windows Tools ...

Windows Server
Suche passender Treiber (12)

Frage von stolli zum Thema Windows Server ...