Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

2 Zusatzfunktionen für QB, DIR$ und PATH$

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
A.K.



Anmeldungsdatum: 02.05.2005
Beiträge: 467
Wohnort: HH

BeitragVerfasst am: 16.09.2006, 13:39    Titel: 2 Zusatzfunktionen für QB, DIR$ und PATH$ Antworten mit Zitat

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. happy

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. grinsen
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. happy

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:
Code:

PRINT PATH$


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
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen Yahoo Messenger MSN Messenger
Jojo
alter Rang


Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte

BeitragVerfasst am: 16.09.2006, 20:52    Titel: Antworten mit Zitat

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
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
csde_rats



Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur

BeitragVerfasst am: 12.02.2007, 18:17    Titel: Antworten mit Zitat

Ziemlich praktisch happy und der link ist immer noch nocht 404 grinsen
_________________
If hilfreicher_Beitrag then klick(location.here)

Klick
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Projektvorstellungen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
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.

 Impressum :: Datenschutz