 |
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 |
Flo
aka kleiner_hacker
Anmeldungsdatum: 23.06.2006
Beiträge: 1210
|
 Verfasst am: 20.08.2006, 11:09 Titel: |
 |
|
[quote="king01]Projektidee[/quote]
Schaut mal hier
_________________
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 |
|
 |
pinkpanther
Anmeldungsdatum: 28.05.2005
Beiträge: 79
Wohnort: Wien
|
| Verfasst am: 20.08.2006, 18:30 Titel: |
|
|
Einen Dateisplitter zu proggen ist wohl doch nicht so trivial... 
Ich habe Sebastians Code interessehalber nach QB portiert, aber damit kein Glück gehabt. Hat die Quelldatei eine Dateinamenerweiterung, stürzt das Programm mit "Bad file name" ab, hat die Quelldatei keine Dateinamenerweiterung, setzt es dafür einen "Illegal function call".
Ich habe dann nicht weiter getestet, sondern den Code grundlegend überarbeitet. Meine Lösung ist wahrscheinlich auch nicht wasserdicht, aber vielleicht eine bessere Annäherung an das Thema.
| Code: | 'Beispielcode fuer einen
'DATEISPLITTER IN QBASIC 7.1
'
'- verwendet CALL INTERRUPTX, daher IDE mit
' Parameter /l starten
'- lauffaehig unter QBasic 4.5, wenn in der Prozedur
' GetQuellDatei Zeile 22 auskommentiert und
' die Auskommentierung von Zeile 23 aufgehoben wird
'- basierend auf einer Idee von Sebastian Steiner,
' 19.08.2006, www.sebastian-steiner.de
'- verfeinert von pinkpanther am 20.08.2006
' mailto: office -AT- datenschutzministerium -DOT- de
'- Dieser Quellcode kann frei verwendet werden.
' Fuer eventuelle Schaeden wird nicht gehaftet.
DefInt A-Z
Declare Sub BatchAnlegen ()
Declare Sub DateiKuerzen (riDateiNr%, rlBytePos&)
Declare Sub DateiSplitten ()
Declare Function GetQuellDatei% ()
Declare Function GetTeileGroesse% ()
Declare Function InstrRev% (rtString$, rtMatchString$)
Declare Sub Intro ()
'Registerabbild
' benoetigt fuer den Aufruf von CALL INTERRUPT
Type RegType
AX As Integer
BX As Integer
CX As Integer
DX As Integer
BP As Integer
SI As Integer
DI As Integer
Flags As Integer
DS As Integer
ES As Integer
End Type
Dim Shared InRegs As RegType, OutRegs As RegType
'Data Transfer Area
' benoetigt fuer die Dateisuche mit Interrupt &H21
Type DTA
fReserviert As String * 21
fAttribut As String * 1
fDateiZeit As String * 2
fDateiDatum As String * 2
lDateiGroesse As Long
fDateiName As String * 13
End Type
Dim Shared DtaDaten As DTA
Dim Shared ptQuellDateiPfad$
Dim Shared ptQuellDateiName$, ptQuellDateiVerz$
Dim Shared ptQuellDateiErweit$, plQuellDateiGroesse&
Dim Shared plTeilDateiGroesse&, piAnzTeile%
'Anzahl Teildateien begrenzen, da die Laenge der
' DOS -Befehlszeile begrenzt ist (Batch-Datei!)
Const MAXTEILE = 10
'Zustaende fuer die Programmsteuerung
Const ERLEDIGT = 0, UNGUELTIG = -1, ABGEBROCHEN = -2
'Anfuehrungsstriche
QUOTE$ = Chr$(34)
'HAUPTPROGRAMM
Intro
iStatus = ABGEBROCHEN
If GetQuellDatei = ERLEDIGT Then
If GetTeileGroesse = ERLEDIGT Then
DateiSplitten
BatchAnlegen
iStatus = ERLEDIGT
End If
End If
If iStatus = ERLEDIGT Then
Print " - Fertig!"
Else
Print " - Verarbeitung abgebrochen!"
End If
While Len(InKey$) = 0: Wend
End
Sub BatchAnlegen
'- legt die Batchdatei an, mit der die Teildateien wieder
' zusammengefuegt werden koennen.
iPos = InstrRev(ptQuellDateiName$, ".")
If iPos Then
ptBatchDateiName$ = Left$(ptQuellDateiName$, iPos - 1)
Else
ptBatchDateiName$ = ptQuellDateiName$
End If
ptBatchDateiName$ = ptBatchDateiName$ + ".BAT"
ptBatchDateiPfad$ = ptQuellDateiVerz$ + "\" + ptBatchDateiName$
iAusgabeDatei = FreeFile
Open ptBatchDateiPfad$ For Output As #iAusgabeDatei
Print #iAusgabeDatei, "@ECHO OFF"
'Standard-Laufwerk setzen:
' bei absoluter Pfadangabe (Doppelpunkt vorhanden)
' die ersten 2 Zeichen des Quelldatei-Verzeichnisses,
' ansonsten des aktuellen Verzeichnisses verwenden
If Mid$(ptQuellDateiVerz$, 2) = ":" Then
tLaufwerksWechsel$ = Left$(ptQuellDateiVerz$, 2)
Else
tLaufwerksWechsel$ = Left$(CurDir$, 2)
End If
Print #iAusgabeDatei, tLaufwerksWechsel$
Print #iAusgabeDatei, "CD " + ptQuellDateiVerz$
Print #iAusgabeDatei, "ECHO Erstelle "; ptQuellDateiName$; "..."
Print #iAusgabeDatei, "COPY /B ";
For iTeil = 1 To piAnzTeile
tZaehler$ = Mid$(Str$(1000 + iTeil), 3)
tTeilDateiName$ = ptQuellDateiName$ + "." + tZaehler$
Print #iAusgabeDatei, tTeilDateiName$;
If iTeil < piAnzTeile Then
Print #iAusgabeDatei, "+";
End If
Next
Print #iAusgabeDatei, " "; ptQuellDateiPfad$
Print #iAusgabeDatei, "ECHO Fertig."
Print #iAusgabeDatei, "PAUSE"
Close #iAusgabeDatei
Print " - Batchdatei ";
Print QUOTE$ + ptBatchDateiName$ + QUOTE$ + " angelegt."
End Sub
Sub DateiKuerzen (riDateiNr%, rlNeueLaenge&)
If Lof(riDateiNr%) > rlNeueLaenge& Then
Seek riDateiNr%, rlNeueLaenge& + 1
InRegs.AX = &H4000
InRegs.BX = FileAttr(riDateiNr%, 2)
InRegs.CX = 0
Call Interrupt(&H21, InRegs, OutRegs)
End If
End Sub
Sub DateiSplitten
tPuffer$ = Space$(plTeilDateiGroesse&)
iEingabeDatei = FreeFile
Open ptQuellDateiPfad$ For Binary Access Read As #iEingabeDatei
iAusgabeDatei = FreeFile
Do
lRestGroesse& = Lof(iEingabeDatei) - Loc(iEingabeDatei)
If lRestGroesse& Then
piAnzTeile = piAnzTeile + 1
If lRestGroesse& < plTeilDateiGroesse& Then
tPuffer$ = Space$(lRestGroesse&)
End If
Get #iEingabeDatei, , tPuffer$
tZaehler$ = Mid$(Str$(1000 + piAnzTeile), 3)
tTeilDateiName$ = ptQuellDateiName$ + "." + tZaehler$
tTeilDateiPfad$ = ptQuellDateiVerz$ + "\" + tTeilDateiName$
Open tTeilDateiPfad$ For Binary As #iAusgabeDatei
Put #iAusgabeDatei, , tPuffer$
DateiKuerzen iAusgabeDatei, Loc(iAusgabeDatei)
Close #iAusgabeDatei
End If
Loop While lRestGroesse&
Close #iEingabeDatei
Print " - Datei in"; Str$(piAnzTeile); " Teile gesplittet."
End Sub
Function GetQuellDatei
' - fordert den Benutzer zur Eingabe eines Quelldatei-Pfades auf;
' - die Datei muss existieren und darf nicht leer sein;
' - ermittelt die Groesse der Quelldatei;
' - splittet den Quelldatei-Namen in Verzeichnis, Dateiname und
' Erweiterung auf;
' - Rueckgabewert Programmstatus ERLEDIGT oder ABGEBROCHEN
Do
Input "Quelldatei (Datei oder Pfad): ", ptQuellDateiPfad$
If Len(ptQuellDateiPfad$) Then
ptQuellDateiPfad$ = UCase$(LTrim$(RTrim$(ptQuellDateiPfad$)))
'Existenz der Quelldatei pruefen
' - DTA einrichten
' - Datei suchen
InRegs.DX = Varptr(DtaDaten)
InRegs.DS = -1
InRegs.AX = &H1A00
Call InterruptX(&H21, InRegs, OutRegs)
tPfad0$ = ptQuellDateiPfad$ + Chr$(0)
InRegs.DX = Sadd(tPfad0$)
InRegs.DS = SSeg(tPfad0$)
'InRegs.DS = -1 'QB4.5
InRegs.CX = 39 'Attribute der gesuchten Datei
InRegs.AX = &H4E00
Call InterruptX(&H21, InRegs, OutRegs)
If OutRegs.Flags And 1 Then
Print " - Datei nicht gefunden!"
iEingabeStatus = UNGUELTIG
Else
plQuellDateiGroesse& = DtaDaten.lDateiGroesse&
If plQuellDateiGroesse& Then
iPos = InstrRev(ptQuellDateiPfad$, "\")
ptQuellDateiVerz$ = Left$(ptQuellDateiPfad$, iPos - 1)
ptQuellDateiName$ = Mid$(ptQuellDateiPfad$, iPos + 1)
iPos = InstrRev(ptQuellDateiName$, ".")
If iPos Then
ptQuellDateiName$ = Left$(ptQuellDateiName$, iPos - 1)
ptQuellDateiErweit$ = Mid$(ptQuellDateiName$, iPos + 1)
End If
iEingabeStatus = ERLEDIGT
Else
Print " - Die Datei ist leer!"
iEingabeStatus = UNGUELTIG
End If
End If
Else
iEingabeStatus = ABGEBROCHEN
End If
Loop While iEingabeStatus = UNGUELTIG
GetQuellDatei = iEingabeStatus
End Function
Function GetTeileGroesse
' - fragt vom Benutzer die Groesse der anzulegenden Teildateien ab
' und errechnet die Anzahl der Teildateien
' - die Groesse muss zwischen 1 und 32.767 liegen
' - es duerfen max. MAXTEILE Teildateien angelegt werden
Do
Input "Groesse der Teildateien (in Bytes): ", plTeilDateiGroesse&
Select Case plTeilDateiGroesse&
Case 1 To 32767
iTeile = plQuellDateiGroesse& \ plTeilDateiGroesse&
If plQuellDateiGroesse& Mod plTeilDateiGroesse& Then
iTeile = iTeile + 1
End If
Print " - errechnete Anzahl Teildateien:" + Str$(iTeile)
If iTeile > MAXTEILE Then
Print " - max." + Str$(MAXTEILE); " Teildateien moeglich!"
iEingabeStatus = UNGUELTIG
Else
iEingabeStatus = ERLEDIGT
End If
Case Else
If plTeilDateiGroesse& Then
Print " - Groesse zwischen 1 und 32.767 Zeichen waehlen!"
iEingabeStatus = UNGUELTIG
Else
iEingabeStatus = ABGEBROCHEN
End If
End Select
Loop While iEingabeStatus = UNGUELTIG
GetTeileGroesse = iEingabeStatus
End Function
Function InstrRev (rtString$, rtMatchString$)
'ermittelt die Position des letzten Vorkommens von
' rtMatchString$ in rtString$ und gibt sie als
' Funktionsrueckgabewert zurueck.
Static iAltPos, iPos
iPos = 0
Do
iAltPos = iPos
iPos = Instr(iPos + 1, rtString$, rtMatchString$)
Loop While iPos
InstrRev% = iAltPos
End Function
Sub Intro
Cls
Print
Print " ----------------------------------------------------------------------"
Print " DATEI-SPLITTER"
Print " ----------------------------------------------------------------------"
Print " Teilt eine Quelldatei in mehrere Teildateien auf, deren Groesse"
Print " vom Benutzer bestimmt wird und erstellt eine Batchdatei, mit deren"
Print " Hilfe die Teil-Dateien wieder zusammengefuegt werden koennen."
Print
Print " Abbruch jederzeit durch Leereingabe moeglich."
Print
Print " Nach einer Idee von Sebastian Steiner,"
Print " verfeinert von pinkpanther."
Print " ----------------------------------------------------------------------"
Print
End Sub |
_________________
lG
pinkpanther  |
|
| Nach oben |
|
|
Stormy
Anmeldungsdatum: 10.09.2004
Beiträge: 567
Wohnort: Sachsen - wo die schönen Frauen wachsen ;)
|
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
| Verfasst am: 20.08.2006, 20:06 Titel: |
|
|
@pinkpanther: Dass es unter QB nicht ohne Weiteres geht, liegt daran, dass QB ja nur die 8.3 Dateinamen unterstützt, FB hingegen mit nahezu beliebigen Dateinamen umgehen kann. Mein kleiner Splitter macht nämlich aus einer test.exe z.B. 3 Teile, die dann test.exe.001, test.exe.002 und test.exe.003 heißen. Diese Doppelendung ist natürlich alles andere als DOS-tauglich. Dein Code ist viel schöner, ich hab meinen nur so rasch hingeschmissen, um zu zeigen, dass es auch mit weniger als 100 Zeilen geht. 
_________________
Die gefährlichsten Familienclans | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen! |
|
| Nach oben |
|
|
pinkpanther
Anmeldungsdatum: 28.05.2005
Beiträge: 79
Wohnort: Wien
|
| Verfasst am: 20.08.2006, 20:31 Titel: |
|
|
@Sebastian
Du hast eine Lösung in FreeBasic vorgestellt, ich meine in QBasic programmiert. In beiden Sprachen hat man es mit unterschiedlichen Regeln zu tun, weshalb mir die direkte Portierung deines FreeBasic-Codes nach QBasic nicht gelungen ist. Dir ging's zudem um eine möglichst kompakte Lösung, mir um eine möglichst umfassende.
Die umfassende Variante hat mich interessiert, daher habe ich deine Lösung, anstatt sie einfach an QBasic anzupassen, entsprechend umgeschrieben. Mein Beitrag sollte jedenfalls keine Kritik an deinem Lösungsansatz darstellen.
_________________
lG
pinkpanther |
|
| Nach oben |
|
|
Jet X
gesperrt
Anmeldungsdatum: 05.01.2005
Beiträge: 447
|
| Verfasst am: 21.08.2006, 02:59 Titel: |
|
|
| Zitat: | Ein Programm zum Ausleseen des RAM-Speichers hat Infection93 ja schon ...
Aber ein OS ... hm ... Ich mache gerade eine TUI ... Dann die command.com ersetzen und dann nur noch msdos.sys und io.sys ... ein auf DOS basierendes OS. |
lol... wann glaubt ihr mir endlich? Wieder ein beweis das king01 = infection93 ist! 
_________________
Courage ist gut, aber Ausdauer ist besser. |
|
| Nach oben |
|
|
Bad_King
gesperrt
Anmeldungsdatum: 15.04.2006
Beiträge: 455
Wohnort: nähe Stuttgart
|
| Verfasst am: 21.08.2006, 10:17 Titel: |
|
|
| Jet X hat Folgendes geschrieben: | | lol... wann glaubt ihr mir endlich? Wieder ein beweis das king01 = infection93 ist! |
Warum ist das ein Beweis, das ich Infection währe ....
wann glaubst du mir endlich? king01 <> infection93
_________________
Mein Server: http://gianluca.dyndns.org
(Ist meistens nur Tagsüber an) |
|
| Nach oben |
|
|
Michael Frey
Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz
|
| Verfasst am: 21.08.2006, 18:35 Titel: |
|
|
| Code: | --------------------------
/| /| | |
||__|| | Trolle bitte |
/ O O\__ nicht |
/ \ füttern! |
/ \ \ |
/ _ \ \ ----------------------
/ |\____\ \ ||
/ | | | |\____/ ||
/ \|_|_|/ | __||
/ / \ |____| ||
/ | | /| | --|
| | |// |____ --|
* _ | |_|_|_| | \-/
*-- _--\ _ \ // |
/ _ \\ _ // | /
* / \_ /- | - | |
* ___ c_c_c_C/ \C_c_c_c____________ |
_________________
http://de.wikibooks.org/wiki/FreeBasic Jede Hilfe für dieses Buch ist Willkommen!
http://de.wikibooks.org/wiki/FreeBasic:_FAQ FAQ zu Freebasic (im Aufbau, hilfe Willkommen)
Neu mit Syntax Highlight |
|
| Nach oben |
|
|
jb
Anmeldungsdatum: 14.01.2005
Beiträge: 2010
|
| Verfasst am: 21.08.2006, 18:36 Titel: |
|
|
| Code: |
IF (King01 = Infection93) OR (King01 <> Infection93) THEN
IgnoreThread()
END IF
|
jb
_________________
Elektronik und Programmieren |
|
| Nach oben |
|
|
Bad_King
gesperrt
Anmeldungsdatum: 15.04.2006
Beiträge: 455
Wohnort: nähe Stuttgart
|
| Verfasst am: 21.08.2006, 18:59 Titel: |
|
|
| Stormy hat Folgendes geschrieben: | | Du kannst auch gerne bei meinem RPG mithelfen. Tilesets entwerfen, Karten machen, Geschichte ausarbeiten und so. |
Was ist ein RPG ?
_________________
Mein Server: http://gianluca.dyndns.org
(Ist meistens nur Tagsüber an) |
|
| Nach oben |
|
|
Michael Frey
Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz
|
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 21.08.2006, 21:27 Titel: |
|
|
übersetzt man das ins deutsche, kommt "rollenspiel" raus  seltsamer name,oder? 
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
REZK
Anmeldungsdatum: 28.10.2004
Beiträge: 109
Wohnort: Stuttgart
|
| Verfasst am: 27.08.2006, 17:19 Titel: |
|
|
Hallo,
so hätte noch ne interessante Projektidee, wenn ich irgendwann mal zeit haben sollte, setzte ich sie vielleicht auch selbst um:
Ich weiss nicht ob ihr Tron (http://de.wikipedia.org/wiki/Tron_%28Computerspiel%29) kennt, also dieses Spiel mit den 2 Schlangen, die weder sich noch die jeweils andere Schlange berühren dürfen. Wer am längsten durchhält hat gewonnen...
Meine Idee wäre, dass man diese Schlangen nicht mehr per Tastatur steuert sondern durch selbstgeschriebenen Code (vielleicht in einer Assembler ähnlichen Syntax), dass das Tron- Programm interpretiert, sodass man 2 Schlangen- "Bots" gegeneinander antreten lassen könnte...
Naja, vielleicht wäre das ja was,
MfG,
rezk
_________________
Meine sämtlichen QB Projekte findet ihr hier |
|
| Nach oben |
|
|
dreael
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 2511
Wohnort: Hofen SH (Schweiz)
|
| Verfasst am: 27.08.2006, 19:28 Titel: |
|
|
@REZK:
Schau Dir sonst
http://www.dreael.ch/Deutsch/Download/Rasterbike.html
aus meiner Sammlung an. Der Rasterbike-Autopilot (monentan in C für UNIX/Linux programmiert) ist übrigens exakt ein solcher Bot. Diesem habe ich auch bereits eine Auswahl an "Strategien" verpasst (als 1. Kommandozeilenparameter). Sind allerdings alles verhältnismässig simple Computergegner, aber Du bist sonst gerne eingeladen, das Ganze auf die Spitze zu treiben, alles liegt sonst als Open Source zum Download bereit.
Ein WINSOCK.DLL-Spezialist kann sich sonst gerne ans Werk machen, den Autopilot zu FreeBasic portieren.
_________________
Teste die PC-Sicherheit mit www.sec-check.net |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 09.09.2006, 21:55 Titel: |
|
|
http://www.petesqbsite.com/sections/challenges/challenges.shtml
das hier könnte dich / euch auch ne weile beschäftigen.... einfach mal probiern!
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Eisbaer
Anmeldungsdatum: 16.10.2004
Beiträge: 354
Wohnort: Deutschland,Bayern
|
| Verfasst am: 10.09.2006, 10:38 Titel: Re: Projektidee |
|
|
| king01 hat Folgendes geschrieben: | Hi,
ich hab leider keine Idee was ich programmieren könnte.
Hättet ihr da vielleicht ne Idee? |
Ähm, nur mal so als Frage wiso beginnt man den mit dem Programieren ?
Eigentlich weil man entweder was erschaffen will was andere noch nicht gemacht haben, oder um etwas selber so zu schreiben wie man es gerne hätte.
Also wie kommen dann diese Sätze zu Stande ? Mann hat doch eigentlich immer Vorstellungen was man machen möchte. Mann könnte es ja auch erst mal lassen mit dem Programmieren wenn einem nichts einfällt und warten bis mann wieder eine Idee hat.
Gruß Eisbaer
_________________
Eigene Webseite:
http://www.eisbaer-studios.de |
|
| 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
