 |
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 |
A.K.

Anmeldungsdatum: 02.05.2005 Beiträge: 467 Wohnort: HH
|
Verfasst am: 16.09.2006, 13:39 Titel: 2 Zusatzfunktionen für QB, DIR$ und PATH$ |
|
|
Hi Leudz,
mir war mal wieder langweilig und ich habe ma zwischendurch zwei kleine Funktionen geschrieben die einem das Programmieren ein wenig erleichtern wenn man QB (v4.0, v.45, qbx/pds) benutzt.
DIR$:
Der bisherige Standard in QB für eine DIR-Funktion war folgende:
Code: |
SHELL "DIR *.* >temp.tmp"
'OPEN, INPUT, CLOSE...
|
Dies hatte 3 gravierende Nachteile (finde ich jedenfalls).
- Speicher-"verbrauch" durch laden des Shell-Interpreters
- Anlegen einer externen Datei
- sporadische Grafikfehler. (Besonders in VESA-Modi)
Da mich diese 3 Punkte störten, habe ich ein DIR$ gebastelt welches
alle 3 ebend genannten negativen Punkte behebt/weglässt.
Ein Codebeispiel um Verzeichnisse des aktuellen Pfades auszulesen:
Code: |
suche$ = "*.*"
DO
FileName$ = Dir$(suche$, 16)
IF FileName$ <> "" THEN PRINT FileName$
suche$ = ""
LOOP UNTIL FileName$ = ""
|
Ein Codebeispiel um Dateien des aktuellen Pfades auszulesen:
Code: |
suche$ = "*.*"
DO
FileName$ = Dir$(suche$, 0)
IF FileName$ <> "" THEN PRINT FileName$
suche$ = ""
LOOP UNTIL FileName$ = ""
|
Diese Funktionsweise ist recht flexibel und dürfte VB.NET-Programmierern bekannt vorkommen.
Der Quellcode:
Was wäre eine Programm ohne ein bischen Assembler und Interrupten. Aus diesem Grund wird davon natürlich stark Gebrauch gemacht.
Aber denjenigen denen beim Lesen der Worte "Assembler" und "Interrupten" die Mundwinkel entgleisen sei gesagt das sie die Funktionen ohne spezielles Wissen einfach in ihre Programme reinkopieren können.
So, nun zum Code.
Das erste was jetzt kommt sind Variablen die ins Hauptprogramm kopiert werden müssen:
Code: |
TYPE regtypex
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 reg AS regtypex
|
Da nachfolgende Programme die Funktionen CALL ABSOLUTE und CALL INTERRUPTX benutzen muß QB mit dem Parameter "/L" aufgerufen werden!
So, und nun die DIR-Funktion selber:
Code: |
FUNCTION Dir$ (search$, opt%)
'-------------------------------------------------------------------------
' Beim ersten Aufruf wir das MemCopy-Assemblerprogramm geladen
'-------------------------------------------------------------------------
STATIC firstrun%, prog$
IF firstrun% = 0 THEN
memc$ = "1E5589E58E460C8B7E0A8E5E108B760E8B4E08F3A45D1FCB"
GOSUB ConvertHEX2ASC: memc$ = "": firstrun% = 1
END IF
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'Disk Transfer Area-Adresse ermitteln
'-------------------------------------------------------------------------
reg.ax = &H2F00
CALL INTERRUPTX(&H21, reg, reg)
DTAseg% = reg.es
DTAoff% = reg.bx
'-------------------------------------------------------------------------
DO
IF search$ = "" THEN
'-------------------------------------------------------------------------
'Find Next
'-------------------------------------------------------------------------
reg.ax = &H4F00
CALL INTERRUPTX(&H21, reg, reg)
IF reg.ax > 0 THEN Dir$ = "": EXIT FUNCTION
'-------------------------------------------------------------------------
ELSE
'-------------------------------------------------------------------------
'Find First
'-------------------------------------------------------------------------
such$ = search$ + CHR$(0)
reg.ax = &H4E00
reg.cx = opt%
reg.ds = VARSEG(such$)
reg.dx = SADD(such$)
CALL INTERRUPTX(&H21, reg, reg)
'-------------------------------------------------------------------------
END IF
'-------------------------------------------------------------------------
'Dateiname aus DTA rauskopieren unter Beachtung des Attributes
'-------------------------------------------------------------------------
FileName$ = SPACE$(13)
DEF SEG = DTAseg%
atr% = PEEK(DTAoff% + 21)
DEF SEG
IF opt% = 16 THEN
IF atr% = 16 THEN
'-------------------------------------------------------------------------
DEF SEG = VARSEG(prog$)
CALL ABSOLUTE(BYVAL DTAseg%, BYVAL DTAoff% + 30, BYVAL VARSEG(FileName$), BYVAL SADD(FileName$), BYVAL 13, SADD(prog$))
DEF SEG
FileName$ = MID$(FileName$, 1, INSTR(FileName$, CHR$(0)) - 1)
EXIT DO
'-------------------------------------------------------------------------
END IF
ELSE
'-------------------------------------------------------------------------
DEF SEG = VARSEG(prog$)
CALL ABSOLUTE(BYVAL DTAseg%, BYVAL DTAoff% + 30, BYVAL VARSEG(FileName$), BYVAL SADD(FileName$), BYVAL 13, SADD(prog$))
DEF SEG
FileName$ = MID$(FileName$, 1, INSTR(FileName$, CHR$(0)) - 1)
EXIT DO
'-------------------------------------------------------------------------
END IF
LOOP
Dir$ = FileName$
EXIT FUNCTION
'-------------------------------------------------------------------------
'Konvertiert einen HEX-String in einen ASCII-String
'-------------------------------------------------------------------------
ConvertHEX2ASC:
prog$ = SPACE$((LEN(memc$) / 2))
FOR i% = 0 TO LEN(prog$) - 1
ascii% = VAL("&H" + MID$(memc$, i% * 2 + 1, 2))
MID$(prog$, i% + 1, 1) = CHR$(ascii%)
NEXT i%
RETURN
'-------------------------------------------------------------------------
END FUNCTION
|
Übersichtlichkeitsoptimierungen sind bestimmt möglich.
Die zweite Funktion heißt PATH$. Mit ihr ist es möglich den aktuellen Pfad herauszufinden.
Hierfür müssen genauso wie für die DIR$-Funktion die Register ins Hauptprogramm kopiert werden. (siehe DIM reg AS regtypeX)
Der Aufruf:
Der Quellcode:
Code: |
FUNCTION Path$
'-------------------------------------------------------------------------
'aktuellen Laufwerkbuchstaben auslesen
'-------------------------------------------------------------------------
reg.ax = &H1900
CALL INTERRUPTX(&H21, reg, reg)
drive% = reg.ax AND 255
pfad$ = pfad$ + CHR$((reg.ax AND 255) + 65) + ":\"
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
'aktuellen Pfad auslesen
'-------------------------------------------------------------------------
dat$ = SPACE$(64)
reg.ax = &H4700
reg.dx = drive% + 1
reg.si = SADD(dat$)
reg.ds = VARSEG(dat$)
CALL INTERRUPTX(&H21, reg, reg)
pfad$ = pfad$ + dat$
Path$ = pfad$
'-------------------------------------------------------------------------
END FUNCTION
|
Eine BAS-Datei in einer ZIP-Datei versteckt mit den beiden Funktionen und den entsprechenden Programmbeispielen gibt es hier:
http://www.iconsoft.de/temp/dir.zip
Anregungen? Fragen? Kritik? Ideen?
MFG A.K. _________________
http://forum.IconSoft.de
http://www.pnpbb.de - hol dir jetzt dein eigenes kostenloses Forum *NEU* |
|
Nach oben |
|
 |
Jojo alter Rang

Anmeldungsdatum: 12.02.2005 Beiträge: 9736 Wohnort: Neben der Festplatte
|
Verfasst am: 16.09.2006, 20:52 Titel: |
|
|
also ich hab beide funktionen schon, sieht sogar ziemlich gleich aus (ASM-Code...). von daher nicht neu. aber es is natürlich immer gut, wenn man auf shell"dir" verzichtet. denn die ausgabe sieht auf jedem BS verschieden aus und die parameter gehn inder DosBOX z.B: alle nicht. _________________ » Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
Nach oben |
|
 |
csde_rats

Anmeldungsdatum: 07.01.2007 Beiträge: 2292 Wohnort: Zwischen Sessel und Tastatur
|
|
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.
|
|