 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Andy19312
Anmeldungsdatum: 22.10.2005
Beiträge: 428
|
 Verfasst am: 12.07.2009, 22:02 Titel: Filesplitter nochmal |
 |
|
Irgendwas stimmt nicht.
Könnte mir einer sagen was?
Theoretisch macht es aber Sinn.
Hier der code:
| Code: |
Const w = 200, h = 200
Dim As Integer Zeilen, Spalten
ScreenRes w, h, 32,16
dim b as ulongint
dim c as ulongint
dim i as ulongint
dim text as string
dim file_laenge as ulongint
dim cc as string
DIM FixedLenBuffer AS string * 1
'Hier wird erstmal die Dateilänge herausgefunden und in der Variabelen file_laenge abgelegt
OPEN "C:\a.mp3" FOR BINARY AS #1
file_laenge = LOF(1)
print file_laenge
'Hier wird die Datei a.mp3 geöffnet
open "C:\a.mp3" for binary as #1
'Schleife von 1 bis Endbyte
for i = 1 to file_laenge
'Variabele b addieren
b = b + 1
'Hier zum entsprechenden Byte hüpfen und 1 Byte einlesen
Get #1,i, FixedLenBuffer
'Das entsprechende Byte in der Variabelen text speichern
text = text + FixedLenBuffer
FixedLenBuffer = ""
'Wenn 1 Megabyte eingelesen wurde
if b = (1024*1024) then
'Variabele c um 1 addieren
c = c + 1
'Variabele c in einen Textstring umwandeln
cc = str(c)
'Das 1 Megabyte Variabele text in der enstprechenden Datei ablegen
Open "c:\digitalf\"+cc+".bin" For Binary As #2
Put #2, , text
Close #2
'Variabele b wieder den Wert 0
b = 0
'Textstring löschen
text = ""
end if
'Wenn das Ende der Datei erreicht wurde und die Variabele b nicht genau 1 Megabyte groß ist dies ausführen
if i = file_laenge then
'Variabele c um 1 addieren
c = c + 1
'Variabele c in Textstring cc umwandeln
cc = str(c)
'Die Restbytes entsprechend abspeichern
Open "c:\digitalf\"+cc+".bin" For Binary As #2
Put #2, , text
Close #2
end if
next
close #1
sleep
|
|
|
| Nach oben |
|
 |
Andy19312
Anmeldungsdatum: 22.10.2005
Beiträge: 428
|
| Verfasst am: 12.07.2009, 22:04 Titel: |
|
|
Normalerweise müsste 1 Megabyte in den Ordner c:\digitalf gespeichert werden.
Selbstverständlich sind die Dateien 1-..... durchnummeriert.
Aber er speichert kein 1 Megabyte ab, sondern entweder mehr oder weniger Bytes.
Komisch das ganze |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
| Verfasst am: 12.07.2009, 23:28 Titel: |
|
|
Hallo,
ich bin deinen Quelltext jetzt nicht genau durchgegangen, aber ich würde sagen, dass du es dir mit deinen vielen Zählvariablen unnötig kompliziert machst.
Wie wär's hiermit:
| Code: | CONST MegaByte = 1024*1024
DIM AS INTEGER Teildatei = 1
DIM AS STRING Puffer, Dateiname
OPEN "c:\quelldatei.bmp" FOR BINARY ACCESS READ AS #1
DO UNTIL EOF(1)
IF LOF(1)-LOC(1) >= MegaByte THEN
Puffer = SPACE(MegaByte)
ELSE
Puffer = SPACE(LOF(1)-LOC(1))
END IF
Dateiname = "C:\FreeBASIC\temp\Part-"+LTRIM(STR(Teildatei))+".dat"
OPEN Dateiname FOR OUTPUT AS #2 'Datei leeren, falls vorhanden
CLOSE #2
OPEN Dateiname FOR BINARY ACCESS WRITE AS #2
GET #1,,Puffer
PUT #2,,Puffer
CLOSE #2
LOCATE 1,1
PRINT LTRIM(STR((Teildatei*100)/(LOF(1)/MegaByte))); "% verarbeitet."
Teildatei += 1
LOOP
CLOSE #1
SLEEP: END |
Viele Grüße!
Sebastian
_________________
Die gefährlichsten Familienclans | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen! |
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 13.07.2009, 12:21 Titel: |
|
|
Wenns auf Speed ankommt, vorallem wenn die Datei grösser ist, is es sinvoller nicht ständig LOF und LOC zu nutzen, sondern deren Werte zwischen zu speichern. Auserdem ist es nicht nötig, Den Eingabespeicher immer wieder neu mit Space zu erzeugen, da dessen Länge bereits vorhanden ist, und nur unnötig Zeit kostet. Die änderung ist eigentlich nur dann nötig, wenn der Speicher kleiner geworden ist.
| Code: | If Dir("Eingabedatei.txt", -1) = "" Then Print "Eingabedatei nicht gefunden!": End -1
Dim XFN_In as Integer = FreeFile
If Open("Eingabedatei.txt" for Binary as #XFN_In) <> 0 Then Print "Kann Eingabedatei nicht öffnen!": End -1
Dim MX as UInteger = Lof(XFN_In)
Dim XSplitLen as UInteger = 1024 * 1024
Dim T as String = Space(XSplitLen)
Dim XFN_Out as Integer
Dim XCount as UInteger
For X as UInteger = 1 to MX Step XSplitLen
If (MX - X) < XSplitLen Then T = Space(MX - X + 1)
Get #XFN_In, X, T
XCount += 1
If Dir("Outfile_" & Str(XCount) & ".txt", -1) <> "" Then Print "Ausgabedatei '" & Str(XCount) & "' bereits vorhanden!": End -1
XFN_Out = FreeFile
If Open("Outfile_" & Str(XCount) & ".txt" for Binary as #XFN_Out) <> 0 Then Print "Kann Ausgabedatei '" & Str(XCount) & "' nicht öffnen!": End -1
Put #XFN_Out, 1, T
Close #XFN_Out
Next
Close #XFN_Out
Print "Fertig! Es wurden " & Str(XCount) & " Datein erstellt!"
End 0
|
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ]
Zuletzt bearbeitet von ThePuppetMaster am 13.07.2009, 15:36, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
MOD
Fleißiger Referenzredakteur
Anmeldungsdatum: 10.09.2007
Beiträge: 1003
|
| Verfasst am: 13.07.2009, 15:00 Titel: |
|
|
Mal abgesehen davon, dass TPMs und Sebastians Code wunderbar funktionieren, würde mich interessieren, warum Andys Code nicht geht. Liegts daran, dass er die Byte-Variable in den String reinspeichert und die sich nicht vertragen?
Daran, dass er die MP3 zwei mal öffnet liegt es auf jedenfall nicht 
@TPMs Code: Tippfehler in Zeile 10: XSplitLen das "p" vergessen. |
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 13.07.2009, 15:39 Titel: |
|
|
code gefixt
also .. das andy's code nicht geht, kann ich beim überfliegen schon sehen. .. hab ihn aber nicht genauer untersucht.
schwerwiegenster fehler ist wohl die verwendung von #1 .. und das 2x
einmal für das öffnen der quell und einmal für die zieldatei .. das kann nciht gehen, udn sollte wohl schon beim öffnen einen fehler veruhrsachen
darum solte man eigentlich immer mit
| Code: | | if open(bla...) <> 0 |
prüfen, ob das öffnen erfolgreich war ... alternativ kann man den returncode auch genauer prüfen.
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
MOD
Fleißiger Referenzredakteur
Anmeldungsdatum: 10.09.2007
Beiträge: 1003
|
| Verfasst am: 13.07.2009, 16:12 Titel: |
|
|
Da hast du den Code wohl zu schnell überflogen 
Er öffnet zweimal die Quelldatei, was sinnlos, aber nicht die Ursache für den Fehler ist.
Seine Zieldatei öffnet er weiter unten mit #2. |
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 13.07.2009, 16:45 Titel: |
|
|
hast recht .. Über-sehen ... aber, dennoch würde es n fehler beim 2ten öffnen geben 
schliesslich hat er kein Close #1 vor dem 2ten öffnen drin. aber gut .. fehler wird irgend wo anders liegen.
@andy .. was "stimmt" denn nicht?
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
MOD
Fleißiger Referenzredakteur
Anmeldungsdatum: 10.09.2007
Beiträge: 1003
|
| Verfasst am: 13.07.2009, 16:55 Titel: |
|
|
Erzeugt ohne das Close trotzdem keinen Fehler, aber naja.
Was nicht stimmt ist, dass die Dateigröße eigentlich nie dem 1MB entspricht. In meinem Test waren es immer weniger (995, 996 und 992KB).
Auch alle Dateien zusammen haben nie die Größe der Quelldatei.
Problem liegt entweder bei der Aufnahme mit GET oder beim Übertragen auf die Variable text.
Obwohl die Zählvariable b die richtige Größe von 1MB anzeigt, ist die Größe von text immer kleiner. |
|
| Nach oben |
|
|
ThePuppetMaster
Anmeldungsdatum: 18.02.2007
Beiträge: 1839
Wohnort: [JN58JR]
|
| Verfasst am: 13.07.2009, 18:01 Titel: |
|
|
axooo ... naja.. das kann ein problem durch das umkopieren von strings sein.
da kann es schonmal vorkommen, das 0 chr's ignoriert werden. Normalerweise soltle das bei String's nicht passieren, hab aber schon erlebt, das FBC da irgend was anders macht, vorallem wenn man ByRef in sub/func header verwendet. Aber das Problem besteht auch so, in manchen fällen. Welche genau das sind, weis ich aber gerade nicht. vieleicht wäre mal asl debuging-vorschlag zu erwähnen, das bei jedem hinzufügen eines bytes an den string geprüft wird, ob sich der string vergössert hat, oder ob er gleich gross gebleiben ist. Wenn dem der fall ist, kann man ja mal via asc(..) ausgeben, was für ein Chr versucht wurde an den string anzuhängen.
MfG
TPM
_________________
[ WebFBC ][ OPS ][ ToOFlo ][ Wiemann.TV ] |
|
| Nach oben |
|
|
MOD
Fleißiger Referenzredakteur
Anmeldungsdatum: 10.09.2007
Beiträge: 1003
|
| Verfasst am: 13.07.2009, 18:12 Titel: |
|
|
Ja, du hast absolut recht, es sind immer Chr(0) und genauso viele, wie zur Dateigröße fehlen. Ich hab an die Möglichkeit gedacht, aber ich war der Meinung, dass sowas nur bei ZStrings passiert und hab es nicht getestet.
Edit: Wenn man in den Fällen, in denen die Länge gleich bleibt, per Hand einfügt
dann geht der Code. |
|
| Nach oben |
|
|
Andy19312
Anmeldungsdatum: 22.10.2005
Beiträge: 428
|
| Verfasst am: 13.07.2009, 20:53 Titel: |
|
|
Hm,
ich glaube ihr habt die Lösung für das Problem gefunden.
Aber trotzdem nochmal dank an alle, die mir einen Filesplitter gezeigt haben, die sehr viel schneller sind.
Ich werde gleich das Problem mal am Schopf packen und den Fehler wegprogrammieren.
Trotzdem ärgerlich, dass freebasic so komisch mit Strings umgeht.
ACHSO, ich konnte jetzt erst antworten, da ich unterwegs war.
Hier die Lösung:
Das musste geändert werden:
| Code: |
if FixedLenBuffer = "" then
text(1) += CHR(0)
end if
|
So sieht jetzt der Code komplett aus:
| Code: |
Const w = 200, h = 200
Dim As Integer Zeilen, Spalten
ScreenRes w, h, 32,16
dim b as ulongint
dim c as ulongint
dim i as ulongint
redim text (1) as string
dim file_laenge as ulongint
dim cc as string
DIM FixedLenBuffer AS string * 1
'Hier wird erstmal die Dateilänge herausgefunden und in der Variabelen file_laenge abgelegt
OPEN "C:\a.mp3" FOR BINARY AS #1
file_laenge = LOF(1)
close #1
print file_laenge
'Hier wird die Datei a.mp3 geöffnet
open "C:\a.mp3" for binary access read as #1
'Schleife von 1 bis Endbyte
for i = 1 to file_laenge
'Variabele b addieren
b = b + 1
'Hier zum entsprechenden Byte hüpfen und 1 Byte einlesen
Get #1,i, FixedLenBuffer
'Das entsprechende Byte in der Variabelen text speichern
if FixedLenBuffer = "" then
text(1) += CHR(0)
end if
text(1) = text(1) + FixedLenBuffer
FixedLenBuffer = ""
'Wenn 1 Megabyte eingelesen wurde
if b = (1024*1024) then
'Variabele c um 1 addieren
c = c + 1
'Variabele c in einen Textstring umwandeln
cc = str(c)
'Das 1 Megabyte Variabele text in der enstprechenden Datei ablegen
Open "c:\digitalf\"+cc+".bin" For Binary access write As #2
Put #2, , text(1)
Close #2
'Variabele b wieder den Wert 0
b = 0
'Textstring löschen
text(1) = ""
end if
'Wenn das Ende der Datei erreicht wurde und die Variabele b nicht genau 1 Megabyte groß ist dies ausführen
if i = file_laenge AND NOT b = (1024*1024) then
'Variabele c um 1 addieren
c = c + 1
'Variabele c in Textstring cc umwandeln
cc = str(c)
'Die Restbytes entsprechend abspeichern
Open "c:\digitalf\"+cc+".bin" For Binary As #2
Put #2, , text(1)
Close #2
end if
next
close #1
sleep
|
Zuletzt bearbeitet von Andy19312 am 13.07.2009, 23:07, insgesamt 2-mal bearbeitet |
|
| Nach oben |
|
|
Andy19312
Anmeldungsdatum: 22.10.2005
Beiträge: 428
|
| Verfasst am: 13.07.2009, 22:44 Titel: |
|
|
Und noch der Code, der die angelegten 1 Megabyte Dateien "und Restbytes" wieder zu einer Datei zusammenfügt:
| Code: |
Const w = 200, h = 200
Dim As Integer Zeilen, Spalten
ScreenRes w, h, 32,16
dim c as ulongint
dim a as ulongint
dim i as ulongint
dim inhalt as ulongint
dim text as string
DIM FixedLenBuffer AS STRING*1
dim ii as string
dim wo as ulongint
open "C:\digitalf\inhalt.bin" for input as #3
input #3, inhalt
close #3
for i = 1 to inhalt
a = 0
ii = str(i)
open "c:\digitalf\"+ii+".bin" for binary access read as #1
do
a = a + 1
Get #1,a, FixedLenBuffer
if FixedLenBuffer = "" then
text += CHR(0)
end if
text = text + FixedLenBuffer
loop until eof(1)
close #1
Open "c:\digitalf\zusammen.txt" For binary access write As #2
put #2,, text
Close #2
next
|
Das ganze ist aber ziemlich langsam. Könnte mir jemand sagen, warum der Code vom The PuppetMaster schneller läuft? |
|
| Nach oben |
|
|
Flo
aka kleiner_hacker
Anmeldungsdatum: 23.06.2006
Beiträge: 1210
|
| Verfasst am: 14.07.2009, 20:15 Titel: |
|
|
du liest byteweise, TPM liest megabyteweise...
das kannst du dir in etwa so vorstellen:
wie transportiert man schneller 5 liter wasser von a nach b?
mit nem ein-liter-eimern (TPM), oder mit nem schnapsglas (du)
_________________
MFG
Flo
Satoru Iwata: Wer Spaß am Spielen hat, fragt nicht nach Grafik.
zum korrekten Verstaendnis meiner Beitraege ist die regelmaessige Wartung des Ironiedetektors unerlaesslich. |
|
| Nach oben |
|
|
Andy19312
Anmeldungsdatum: 22.10.2005
Beiträge: 428
|
| Verfasst am: 14.07.2009, 20:48 Titel: |
|
|
ok, aber warum geht folgendes nicht:
DIM FixedLenBuffer AS string * 1024*1024
dann stürzt das Programm ab, dann wäre es schonmal keine Schnapsglasvariante mehr, wenn es funktionieren würde
EDIT:HAb die Lösung gefunden, werde sie nachher online stellen.
DIM dateigroesse AS UINTEGER = 1024 * 1024
DIM text AS STRING = SPACE(dateigroesse)
Fragen sich die Geister, warum es so funktioniert.
Cu Andy |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 14.07.2009, 21:17 Titel: |
|
|
| Andy19312 hat Folgendes geschrieben: | | ok, aber warum geht folgendes nicht: |
k. A., bei mir geht es ...
Mag sein, dass er bei dir mit der "Mischung" der Multiplikation von String und Zahlen durcheinanderkommt (vielleicht mal mit Klammern probieren? Oder mit DIM text as string * dateigroesse ?) Wie gesagt, bei mir geht deine erste Variante.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
