' LngFnam.bas version 2 '****************************************************************************** '旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 '� REGNAMES.INC � '� � '� Diese $INCLUDE-Datei vereinfacht die Benutzung des REG-Befehls bei der � '� Anwendung von CALL INTERRUPT. Die Register k봭nen nun mit ihren Namen � '� angesprochen werden. � '� � '� Beispiel: � '� � '� $INCLUDE "REGNAMES.INC" � '� � '� REG %AX, &H0F00 ' INT10h-0F ermittele Grafikmodus � '� CALL INTERRUPT &H10 ' INT10h aufrufen � '� Modus% = (REG(%AX) AND &H00FF) ' nur AL interssant � '� Spalten% = (REG(%AX) AND &HFF00) ' nur AH interssant � '� SHIFT RIGHT Spalten%, 8 ' oberes Byte in unteres Byte schieben � '� Seite% = (REG(%BX) AND &HFF00) ' nur BH interssant � '� SHIFT RIGHT Seite%, 8 ' oberes Byte in unteres Byte schieben � '� � '읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 %FLAGS = 0 %AX = 1 %BX = 2 %CX = 3 %DX = 4 %SI = 5 %DI = 6 %BP = 7 %DS = 8 %ES = 9 DEFINT A-Z %FALSE = 0 %TRUE = NOT %FALSE ' Access modes: %OPEN_ACCESS_READONLY = 0 %OPEN_ACCESS_WRITEONLY = 1 %OPEN_ACCESS_READWRITE = 2 %OPEN_ACCESS_RONOMODLASTACCESS = 4 ' Sharing modes: %OPEN_SHARE_COMPATIBLE = 0 %OPEN_SHARE_DENYREADWRITE = &h10 %OPEN_SHARE_DENYWRITE = &h20 %OPEN_SHARE_DENYREAD = &h30 %OPEN_SHARE_DENYNONE = &h40 ' Flags: %OPEN_FLAGS_NOINHERIT = &h80 %OPEN_FLAGS_NO_BUFFERING = &h100 %OPEN_FLAGS_NO_COMPRESS = &h200 %OPEN_FLAGS_ALIAS_HINT = &h400 %OPEN_FLAGS_NOCRITERR =&h2000 %OPEN_FLAGS_COMMIT =&h4000 ' Attributes: %FILE_ATTRIBUTE_NORMAL = 0 %FILE_ATTRIBUTE_READONLY = 1 %FILE_ATTRIBUTE_HIDDEN = 2 %FILE_ATTRIBUTE_SYSTEM = 4 %FILE_ATTRIBUTE_VOLUME = 8 %FILE_ATTRIBUTE_DIRECTORY = &h10 %FILE_ATTRIBUTE_ARCHIVE = &h20 %FILE_ATTRIBUTE_ALL = _ %FILE_ATTRIBUTE_NORMAL + %FILE_ATTRIBUTE_READONLY + %FILE_ATTRIBUTE_HIDDEN + _ %FILE_ATTRIBUTE_SYSTEM + %FILE_ATTRIBUTE_ARCHIVE %FILE_ATTRIBUTE_READWRITE = _ %FILE_ATTRIBUTE_NORMAL + %FILE_ATTRIBUTE_HIDDEN + %FILE_ATTRIBUTE_SYSTEM + _ %FILE_ATTRIBUTE_ARCHIVE ' Maximum path length %MAX_PATH = 260 %MAX_DOS_PATH = 67 ' DOS errors %NO_ERROR = 0 %ERROR_INVALID_FUNCTION = 1 %ERROR_FILE_NOT_FOUND = 2 %ERROR_PATH_NOT_FOUND = 3 %ERROR_TOO_MANY_OPEN_FILES = 4 %ERROR_ACCESS_DENIED = 5 %ERROR_INVALID_HANDLE = 6 %ERROR_ARENA_TRASHED = 7 %ERROR_NOT_ENOUGH_MEMORY = 8 %ERROR_INVALID_BLOCK = 9 %ERROR_BAD_ENVIRONMENT = &hA %ERROR_BAD_FORMAT = &hB %ERROR_INVALID_ACCESS = &hC %ERROR_INVALID_DATA = &hD %ERROR_INVALID_DRIVE = &hF %ERROR_CURRENT_DIRECTORY = &h10 %ERROR_NOT_SAME_DEVICE = &h11 %ERROR_NO_MORE_FILES = &h12 %ERROR_WRITE_PROTECT = &h13 %ERROR_BAD_UNIT = &h14 %ERROR_NOT_READY = &h15 %ERROR_BAD_COMMAND = &h16 %ERROR_CRC = &h17 %ERROR_BAD_LENGTH = &h18 %ERROR_SEEK = &h19 %ERROR_NOT_DOS_DISK = &h1A %ERROR_SECTOR_NOT_FOUND = &h1B %ERROR_OUT_OF_PAPER = &h1C %ERROR_WRITE_FAULT = &h1D %ERROR_READ_FAULT = &h1E %ERROR_GEN_FAILURE = &h1F %ERROR_SHARING_VIOLATION = &h20 %ERROR_LOCK_VIOLATION = &h21 %ERROR_WRONG_DISK = &h22 %ERROR_FCB_UNAVAILABLE = &h23 %ERROR_SHARING_BUFFER_EXCEEDED = &h24 %ERROR_CODE_PAGE_MISMATCHED = &h25 %ERROR_HANDLE_EOF = &h26 %ERROR_HANDLE_DISK_FULL = &h27 %ERROR_NOT_SUPPORTED = &h32 %ERROR_REM_NOT_LIST = &h33 %ERROR_DUP_NAME = &h34 %ERROR_BAD_NETPATH = &h35 %ERROR_NETWORK_BUSY = &h36 %ERROR_DEV_NOT_EXIST = &h37 %ERROR_TOO_MANY_CMDS = &h38 %ERROR_ADAP_HDW_ERR = &h39 %ERROR_BAD_NET_RESP = &h3A %ERROR_UNEXP_NET_ERR = &h3B %ERROR_BAD_REM_ADAP = &h3C %ERROR_PRINTQ_FULL = &h3D %ERROR_NO_SPOOL_SPACE = &h3E %ERROR_PRINT_CANCELLED = &h3F %ERROR_NETNAME_DELETED = &h40 %ERROR_NETWORK_ACCESS_DENIED = &h41 %ERROR_BAD_DEV_TYPE = &h42 %ERROR_BAD_NET_NAME = &h43 %ERROR_TOO_MANY_NAMES = &h44 %ERROR_TOO_MANY_SESS = &h45 %ERROR_SHARING_PAUSED = &h46 %ERROR_REQ_NOT_ACCEP = &h47 %ERROR_REDIR_PAUSED = &h48 %ERROR_FILE_EXISTS = &h50 %ERROR_DUP_FCB = &h51 %ERROR_CANNOT_MAKE = &h52 %ERROR_FAIL_I24 = &h53 %ERROR_OUT_OF_STRUCTURES = &h54 %ERROR_ALREADY_ASSIGNED = &h55 %ERROR_INVALID_PASSWORD = &h56 %ERROR_INVALID_PARAMETER = &h57 %ERROR_NET_WRITE_FAULT = &h58 %ERROR_SYS_COMP_NOT_LOADED = &h5A ' Win32 structure for file info TYPE Win32_Find_Data dwFileAttributes AS DWORD ftCreationTime AS QUAD ftLastAccessTime AS QUAD ftLastWriteTime AS QUAD nFileSizeHigh AS DWORD nFileSizeLow AS DWORD dwReserved0 AS DWORD dwReserved1 AS DWORD cFileName AS STRING * %MAX_PATH cAlternateFileName AS STRING * 14 END TYPE ' DOS structure for file info TYPE FileInfo fiReserved AS STRING * 21 'for DOS' internal use fiAttribute AS BYTE 'file attribute code fiFileTime AS WORD 'file time (in DOS format) fiFileDate AS WORD 'file date (in DOS format) fiSize AS DWORD 'file size (in bytes) fiFileName AS STRING * 13 'file name (without path) END TYPE DECLARE FUNCTION LfnAlias (BYVAL Lfn AS STRING) AS STRING DECLARE FUNCTION LfnChDir (BYVAL Directory AS STRING) AS INTEGER DECLARE FUNCTION LfnCurDir (BYVAL Drive AS STRING) AS STRING DECLARE FUNCTION LfnDirFirst (BYVAL Mask AS STRING, BYVAL Attr AS BYTE) _ AS STRING DECLARE FUNCTION LfnDirNext () AS STRING DECLARE FUNCTION LfnDirAlias () AS STRING DECLARE SUB LfnFiles () DECLARE FUNCTION LfnGetAttrib (BYVAL File AS STRING) AS INTEGER DECLARE FUNCTION LfnKill (BYVAL File AS STRING) AS INTEGER DECLARE FUNCTION LfnMkDir (BYVAL Directory AS STRING) AS INTEGER DECLARE FUNCTION LfnName (BYVAL OldName AS STRING, BYVAL NewName AS STRING) _ AS INTEGER DECLARE FUNCTION LfnRmDir (BYVAL Directory AS STRING) AS INTEGER DECLARE FUNCTION LfnSetAttrib (BYVAL File AS STRING, BYVAL Attribs AS WORD) _ AS INTEGER DECLARE FUNCTION LfnSupported () AS INTEGER DECLARE FUNCTION CurDrive () AS STRING DECLARE FUNCTION DiskFree (BYVAL Drive AS STRING) AS DWORD DECLARE FUNCTION DOSErr () AS INTEGER DECLARE FUNCTION DOSErrTest () AS INTEGER DECLARE FUNCTION GetDTA () AS DWORD DECLARE FUNCTION GetPtrFindData () AS DWORD DECLARE SUB SetDOSErr (BYVAL DOSErr AS INTEGER) ' Actions for file handling: %FILE_CREATE = &h10 %FILE_OPEN = 1 %FILE_TRUNCATE = 2 DECLARE SUB FindCLose () DECLARE FUNCTION GetDriveNumber (Drive AS STRING) AS BYTE DECLARE FUNCTION LfnSupported2 () AS INTEGER DECLARE FUNCTION LfnSupported3 () AS INTEGER '---------------------------------------------------------------------- ' Shared variables '---------------------------------------------------------------------- DIM DOSError AS SHARED INTEGER ' DOS error code DIM FindHandle AS SHARED WORD ' Handle for Win32 file info DIM FindData AS SHARED Win32_Find_Data ' Structure for ditto DIM PtrFindData AS SHARED Win32_Find_Data PTR ' and its pointer DIM DTA AS SHARED FileInfo PTR ' pointer to structure for DOS ' file info '********************************************************************** Dim Speicher(1 TO 50) AS SHARED STRING DIM SpeicherTyp(1 TO 50) AS SHARED STRING *1 DIM BEFEHLLIST(1 TO 50) AS SHARED STRING DIM FUNCTIONLIST(1 TO 20) AS SHARED STRING DIM WERTLIST(1 TO 20) AS SHARED STRING DIM S(0 TO 255) AS SHARED STRING DIM V(0 TO 255) AS SHARED EXT DIM SNAME(0 TO 255) AS STRING DIM VNAME(0 TO 255) AS STRING DIM FEHLER AS SHARED INTEGER SHARED Position,DOSFEHLER,EXITDOS DIM FunctionDosTyp AS SHARED STRING FunctionDosTyp="S" BEFEHLLIST(1)="PRINT" BEFEHLLIST(2)="LPRINT" BEFEHLLIST(3)="COMMAND" BEFEHLLIST(4)="COMSPEC" BEFEHLLIST(5)="DATE" BEFEHLLIST(6)="FILES" BEFEHLLIST(7)="PLAY" BEFEHLLIST(8)="DRUCKERFARBE" BEFEHLLIST(9)="DRUCKERFARBWERT" BEFEHLLIST(10)="ON BEFEHLLIST(11)="OFF" BEFEHLLIST(12)="IF" BEFEHLLIST(13)="THEN" BEFEHLLIST(14)="LET" BEFEHLLIST(15)="=" BEFEHLLIST(16)=">=" BEFEHLLIST(17)="=<" BEFEHLLIST(18)="<>" BEFEHLLIST(19)="><" BEFEHLLIST(20)="SOUND" BEFEHLLIST(21)="COPY" BEFEHLLIST(22)="XCOPY" BEFEHLLIST(23)="BEFEHLAUSGABE" BEFEHLLIST(24)="VER" BEFEHLLIST(25)="COMMAND.COM" BEFEHLLIST(26)="COMMAND" BEFEHLLIST(27)="CD" BEFEHLLIST(28)="DIR" BEFEHLLIST(29)="EDIT" BEFEHLLIST(30)="EDIT.COM" BEFEHLLIST(31)="XCOPY.EXE" BEFEHLLIST(32)="WIN.COM" BEFEHLLIST(33)="WIN" WERTLIST(1)="FRAC%" WERTLIST(2)="FIX%" reg 1,&h1003 reg 2,0 call interrupt &h10 DECLARE FUNCTION GetStrLoc (BYVAL INTEGER) AS INTEGER DOSBOX SUB DOSBOX ZEILE%=1 SPLATE%=1 FARBEF%=9 FARBEH%=14 CLS FOR X=1 TO 25 TPrint REPEAT$(80," "+CHR$(FARBEF+FARBEH*16)),X,1 NEXT IF EXIST("DOS.INI") THEN END IF PROMPT$="$P>" DO SPALTEP%=SUBPROMPT (PROMPT$,(FARBEF),(FARBEH),ZEILE%,SPLATE%) CPrint SPACE$(80-SPALTEP%),ZEILE%,SPALTEP%+1 ,FARBEF%,FARBEH% DO TASTE$=INKEY$ IF SPALTEP%+ZEICHENP%<80 THEN LOCATE ZEILE%,SPALTEP%+ZEICHENP%+1,1 ELSE LOCATE ZEILE%,80,1 END IF SELECT CASE TASTE$ CASE "" CASE CHR$(13) CASE CHR$(0) CASE CHR$(8),CHR$(0,75) IF LEN(EINGABE$)>0 THEN TPrint " ",ZEILE%,SPALTEP%+ZEICHENP% DECR ZEICHENP% EINGABE$=LEFT$(EINGABE$,LEN(EINGABE$)-1) END IF CASE ELSE IF ASCII(TASTE$)>30 THEN IF SPALTEP%+ZEICHENP%<80 THEN INCR ZEICHENP% TPrint TASTE$,ZEILE%,SPALTEP%+ZEICHENP% EINGABE$=EINGABE$+TASTE$ END IF END IF END SELECT loop until TASTE$=CHR$(13) and LEN(EINGABE$)>0 ZEICHENP%=0 IF SPALTEP%>0 THEN IF ZEILE%<25 THEN INCR ZEILE% ELSE ScrollUp 1,1,28,80,INT(FARBEF%+FARBEH%*16),1 END IF END IF BEFEHLZEILE(EINGABE$) AUSGABE$=Dosbefehl$ IF EXITDOS=-1 THEN LOCATE ,,0 EXIT SUB END IF IF DOSERR>0 THEN SELECT CASE DOSFEHLER CASE 5 IF BEFEHLAUSGABE=-1 THEN BPrint AUSGABE$,ZEILE%,1 ELSE BPrint "Befehl oder Datei nicht gefunden.",ZEILE%,1 END IF END SELECT DOSFEHLER=0 IF ZEILE%<25 THEN INCR ZEILE% ELSE ScrollUp 1,1,28,80,INT(FARBEF%+FARBEH%*16),1 END IF END IF EINGABE$="" TASTE$="" loop END SUB sub TPrint(TXT$,row%,col%) xy%=abs(((row%-1)*160))+((col%-1)*2) IF row%<1 then exit sub IF col%<1 then exit sub IF row%>25 then exit sub IF col%>80 then exit sub def seg=&Hb800 POKE$ XY%,TXT$ def SEG end sub reg 1,&h1003 reg 2,0 call interrupt &h10 sub CPrint(TXT$,row%,col%,fg%,bg%) PUBLIC IF MAUSAN=-1 THEN MsCursorOFF xy%=abs(((row%-1)*160))+((col%-1)*2) def seg=&Hb800 n%=0%:z%=0 for i%=0 to (len(txt$)*2)-1 step 2 t%=asc(mid$(txt$,n%+1,1)) poke xy%+z%, t% 'Text ausgeben poke xy%+z%+1,fg%+(bg% * 16) 'Attribut ausgeben z%=z%+2 n%=n%+1% next i% def seg IF MAUSAN=-1 THEN MsCursorOn end sub sub BPrint(TXT$,row%,col%) PUBLIC IF MAUSAN=-1 THEN MsCursorOFF xy%=abs(((row%-1)*160))+((col%-1)*2) def seg=&Hb800 n%=0%:z%=0 for i%=0 to (len(txt$)*2)-1 step 2 t%=asc(mid$(txt$,n%+1,1)) poke xy%+z%, t% 'Text ausgeben z%=z%+2 n%=n%+1% next i% def seg IF MAUSAN=-1 THEN MsCursorOn end sub FUNCTION SUBPROMPT(PROMPT$,FARBEF,FARBEH,ZEILE%,SPALTE%) LFN=1 IF PROMPT$="" THEN PROMPT$= "$P>" FOR X=1 TO LEN(PROMPT$) ZEICHEN=0 SELECT CASE MID$(prompt$, x, 1) CASE "$" IF HEX%(MID$(prompt$, x+1, 1))=-1 THEN SELECT CASE MID$(prompt$, X+1, 1) CASE "Q" ZEICHEN$="=" CASE "$" ZEICHEN$="$" CASE "T" ZEICHEN$=TIME$ CASE "D" ZEICHEN$=DATE$ CASE "p" IF LFN=0 THEN IF RIGHT$(CURDIR$,1)="\" THEN ZEICHEN$=CURDIR$ ELSE ZEICHEN$=CURDIR$+"\" END IF ELSE IF RIGHT$(Win95Pfad$(CURDIR$),1)="\" THEN ZEICHEN$=Win95Pfad$(CURDIR$) ELSE ZEICHEN$=Win95Pfad$(CURDIR$)+"\" END IF END IF CASE "P" IF LFN=0 THEN IF RIGHT$(CURDIR$,1)="\" THEN ZEICHEN$=MID$(CURDIR$,1,LEN(CURDIR$)-1) ELSE ZEICHEN$=CURDIR$ END IF ELSE IF RIGHT$(Win95Pfad$(CURDIR$),1)="\" THEN ZEICHEN$=MID$(Win95Pfad$(CURDIR$),1,LEN(Win95Pfad$(CURDIR$))-1) ELSE ZEICHEN$=Win95Pfad$(CURDIR$) END IF END IF CASE "N" ZEICHEN$=LEFT$(CURDIR$,1) CASE ":" ZEICHEN$=LEFT$(CURDIR$,3) CASE "G" ZEICHEN$=">" CASE "L" ZEICHEN$="<" CASE "B" ZEICHEN$="|" CASE "-" ZEICHEN$= "�" CASE "I" ZEICHEN$= "�" CASE "?" ZEICHEN$= "�" CASE "<" ZEICHEN$= "�" CASE ">" ZEICHEN$= "�" CASE "\" ZEICHEN$= "�" CASE "+" ZEICHEN$= "�" CASE "=" ZEICHEN$= "�" CASE "X" IF FARBEF < 16 THEN INCR FARBEF ,16 ELSE DECR FARBEF,16 CASE "x" IF FARBEH < 16 THEN INCR FARBEH ,16 ELSE DECR FARBEH,16 CASE "H" IF LEN(ZEICHENS$)>1 THEN ZEICHENS$=MID$(ZEICHENS$,1,LEN(ZEICHENS$)-2) END IF CASE ELSE ZEICHEN$=MID$(prompt$, x, 2) END SELECT ELSE FARBEF=HEX%(MID$(prompt$, x+1, 1)) END IF CASE "~" IF HEX%(LCASE$(MID$(prompt$, x+1, 1)))<>-1 THEN FARBEH=HEX%(LCASE$(MID$(prompt$, x+1, 1))) ELSE IF MID$(prompt$, x+1, 1)="~" THEN ZEICHEN$="~" ELSE ZEICHEN$=MID$(prompt$, x, 2) END IF END IF CASE "@" FARBE1=HEX%(LCASE$(MID$(prompt$, x+1, 1))) FARBE2=HEX%(LCASE$(MID$(prompt$, x+2, 1))) IF FARBE1>-1 AND FARBE2>-1 THEN FARBEF=FARBE1 FARBEH=FARBE2 INCR X ELSE IF MID$(prompt$, x+1, 1)="@" THEN ZEICHEN$="@" ELSE ZEICHEN$=MID$(prompt$, x, 2) END IF END IF CASE ELSE ZEICHEN=1 ZEICHEN$=MID$(prompt$, x, 1) END SELECT IF LEN(ZEICHEN$)>0 THEN FOR ZZ=1 TO LEN(ZEICHEN$) ZEICHENS$=ZEICHENS$+MID$(ZEICHEN$,ZZ,1)+CHR$(FARBEF+FARBEH*16) NEXT ZEICHEN$="" END IF IF ZEICHEN<>1 THEN INCR X NEXT TPrint ZEICHENS$,ZEILE%,SPALTE% IF LEN(ZEICHENS$)>1 THEN FUNCTION=LEN(ZEICHENS$)/2 END FUNCTION FUNCTION HEX%(HEXS$) SELECT CASE HEXS$ CASE "0" HEX%=0 CASE "1" HEX%=1 CASE "2" HEX%=2 CASE "3" HEX%=3 CASE "4" HEX%=4 CASE "5" HEX%=5 CASE "6" HEX%=6 CASE "7" HEX%=7 CASE "8" HEX%=8 CASE "9" HEX%=9 CASE "a" HEX%=10 CASE "b" HEX%=11 CASE "c" HEX%=12 CASE "d" HEX%=13 CASE "e" HEX%=14 CASE "f" HEX%=15 CASE ELSE HEX%=-1 END SELECT END FUNCTION FUNCTION EXIST(DATEIDA$) ON LOCAL ERROR RESUME NEXT DATEIFREE=FREEFILE OPEN DATEIDA$ FOR INPUT AS DATEIFREE IF ERRTEST<>0 THEN EXIT FUNCTION END IF CLOSE DATEIFREE FUNCTION=-1 END FUNCTION FUNCTION LFNSupport5% public Dummy% = 0 ! mov ax, &h3306 ; wahre DOS Version ermitteln, ! mov bx, &h0 ; unter Umgehung von SETVER ! int &h21 ! cmp bx, 7 ; => 7 dann MS-DOS 7.0 ! jc NoLFN ! mov ax, &h714F ; NextDir als Dummy aufrufen, denn ! int &h21 ; hier erfolgt immer ein Carry-Flag. ' Allerdings erkennen wir dann an AX ' ob der LFN-Support vorhanden ist. ! cmp ax, &h7100 ; Ab MS-DOS 7 bedeutet hier ein ! jz NoLFN ; Wert von &h7100: Use DOS 8.3 ! mov Dummy%,-1 ; functions! NoLFN: LFNSupport% = Dummy% END FUNCTION FUNCTION Dos83Pfad$(BYVAL DirLFN$) public DIM LFNBuffer AS STRING * 128 DirLFN$ = DirLFN$ + CHR$(0) ! push ds ! lea di, LFNBuffer$ ! push ds ; ES:DI auf Stack, erspart au�er- ! push di ; das leidige Umkopieren ! les di, DirLFN$ ; Handle von DirLFN$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; Quelle auf DS:SI umkopieren ! mov si, ax ; ! pop di ; ES:DI umkopiert vom Stack holen ! pop es ; ! mov ax, &h7160 ; Make DOS 8.3 Names ! mov ch, 0 ! mov cl, 1 ! int &h21 ! pop ds i% = INSTR(1, LFNBuffer$, CHR$(0)) Dos83Pfad$ = LEFT$(LFNBuffer$, i%-1) END FUNCTION FUNCTION Win95Pfad$(BYVAL DirLFN$) public DIM LFNBuffer AS STRING * 128 DirLFN$ = DirLFN$ + CHR$(0) ! push ds ! lea di, LFNBuffer$ ! push ds ; ES:DI auf Stack, erspart au�er- ! push di ; das leidige Umkopieren ! les di, DirLFN$ ; Handle von DirLFN$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; Quelle auf DS:SI umkopieren ! mov si, ax ; ! pop di ; ES:DI umkopiert vom Stack holen ! pop es ; ! mov ax, &h7160 ; Make Win95 Names ! mov ch, 0 ! mov cl, 2 ! int &h21 ! pop ds i% = INSTR(1, LFNBuffer$, CHR$(0)) Win95Pfad$ = LEFT$(LFNBuffer$, i%-1) END FUNCTION FUNCTION MSTHERE% PUBLIC AS INTEGER REG 1,0 CALL INTERRUPT &H33 MSTHERE%=REG(1) ' ! push DS ' ! xor AX, AX ' ! int &H33 ' ! xor BX, BX ' ! or AX, AX ' ! jz MsThereDone ' ! dec BX 'MsThereDone: ' ! mov FUNCTION, BX ' ! pop DS END FUNCTION '=========================================================================== ' MSCURSORON - Mauscursor einschalten. ' SUB MSCURSORON PUBLIC '! push DS '! mov AX, 1 '! int &H33 '! pop DS REG 1,1 CALL INTERRUPT &H33 END SUB '=========================================================================== ' MSCURSOROFF - Mauscursor ausschalten. ' SUB MSCURSOROFF PUBLIC ! push DS ! mov AX, 2 ! int &H33 ! pop DS END SUB '=========================================================================== ' MSSTATUS - gibt die gdr갷kten Kn봯fe sowie Zeile und Spalte des Cursors ' zur갷k. ' ' Button = gdr갷kte Maustasten: linke = -1, rechte = - 2, mittlere = -4 ' (bei mehrern Addition z.B. linke+rechte = -3) ' Row = aktuelle Zeile des Mauscursors ' Column = aktuelle Spalte des Mauscursors ' SUB MSSTATUS(Button AS INTEGER, Row AS INTEGER, Column AS INTEGER) PUBLIC ! push DS ! mov AX, &H03 ! int &H33 ! les DI, Button ! mov ES:[DI], BX ! les DI, Row ! mov ES:[DI], DX ! les DI, Column ! mov ES:[DI], CX ! pop DS IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THEN Row = (Row \ 8) + 1 Column = (Column \ 8) + 1 END IF END SUB FUNCTION BEFEHLZEILE(BEFEHL$) BEFEHL$=BEFEHL$+" " BEFEHL=-1 ERASE Speicher,SpeicherTyp BEFEHLLEN=LEN(BEFEHL$) IF BEFEHLLEN=0 THEN EXIT FUNCTION Position=1 FOR P=P+1 TO BEFEHLLEN SELECT CASE MID$(BEFEHL$,P,1) CASE CHR$(34) IF LEN(Speicher(Position))>0 then GOSUB PARAMETERTYPFESTSTELLEN SpeicherTyp(Position)="S" FOR P=P+1 TO BEFEHLLEN IF MID$(BEFEHL$,P,1)=CHR$(34) THEN EXIT FOR Speicher(Position)=Speicher(Position)+MID$(BEFEHL$,P,1) NEXT CASE "+","-","/","*" IF LEN(Speicher(Position))>0 then GOSUB PARAMETERTYPFESTSTELLEN Speicher(Position)=MID$(BEFEHL$,P,1) SpeicherTyp(Position)="M" INCR Position CASE " " IF LEN(Speicher(Position))>0 then GOSUB PARAMETERTYPFESTSTELLEN CASE "/" IF LEN(Speicher(Position))>0 then GOSUB PARAMETERTYPFESTSTELLEN CASE "'" IF LEN(Speicher(Position))>0 then GOSUB PARAMETERTYPFESTSTELLEN EXIT FOR CASE ELSE IF LEN(Speicher(Position))=0 THEN SELECT CASE MID$(BEFEHL$,P,1) CASE "0","1","2","3","4","5","6","7","8","9" Speicher(Position)=MID$(BEFEHL$,P,1) CASE "." 'ECHTE ZAHL SpeicherTyp(Position)="Z" Speicher(Position)="0." CASE ELSE Speicher(Position)=MID$(BEFEHL$,P,1) END SELECT ELSE Speicher(Position)=Speicher(Position)+MID$(BEFEHL$,P,1) END IF END SELECT NEXT FUNCTION=Position Position=0 EXIT FUNCTION PARAMETERTYPFESTSTELLEN: IF LEN(Speicher(Position))=0 THEN RETURN IF BEFEHL=-1 THEN SELECT CASE UCASE$(Speicher(1)) CASE "CLS","BEEP","PAUSE","EXIT" SpeicherTyp(Position)="B" Speicher(Position)=UCASE$(Speicher(Position)) INCR Position BEFEHL=0 RETURN END SELECT END IF SELECT CASE SpeicherTyp(Position) CASE CHR$(0) SELECT CASE RIGHT$(Speicher(Position),1) CASE "$" SpeicherTyp(Position)="F" CASE "%" SpeicherTyp(Position)="W" CASE ELSE IF TALLY(Speicher(Position),ANY ".0123456789")=LEN(Speicher(Position)) THEN SpeicherTyp(Position)="Z" ELSE IF Position=1 AND MID$(Speicher(Position),1,1)=":" THEN SpeicherTyp(Position)="L" Speicher(Position)=UCASE$(MID$(Speicher(Position),2)) EXIT FUNCTION END IF SpeicherTyp(Position)="S" FOR X=1 TO UBOUND(BEFEHLLIST) IF BEFEHLLIST$(X)=UCASE$(Speicher(Position)) THEN SpeicherTyp(Position)="P" Speicher(Position)=UCASE$(Speicher(Position)) BEFEHL=0 EXIT FOR END IF NEXT END IF END SELECT END SELECT INCR Position RETURN END FUNCTION Function Dosbefehl$ Position=0 INCR Position SELECT CASE SpeicherTyp(Position) CASE "P" 'BEFEHL mit parameter SELECT CASE UCASE$(Speicher(Position)) CASE "REM","'" exit function CASE "PRINT" PRINT FunctionDos$("SF") CASE "LPRINT" LPRINT FunctionDos$("SF") CASE "COPY","XCOPY" FEHLER=FileCopy%(FunctionDos$("SF"),FunctionDos$("SF")) CASE "COMMAND" PARAMETER$=FunctionDos$("SF") CASE "COMSPEC" COMSPEC$=FunctionDos$("SF") CASE "DATE" DATE$=FunctionDos$("SF") CASE "FILES" FILES FunctionDos$("SF") CASE "PLAY" PLAY FunctionDos$("SF") CASE "DRUCKERFARBWERT" DRUCKERFARBE%=VAL(FunctionDos$("ZW")) CASE "SOUND" SOUND VAL(FunctionDos$("ZW")),VAL(FunctionDos$("ZW")) CASE "FEHLER" FEHLER=VAL(FunctionDos$("ZW")) CASE "=" VERGLEICH=1 CASE ">=" VERGLEICH=2 CASE "=<" VERGLEICH=3 CASE "<>","><" VERGLEICH=4 CASE "BEFEHLAUSGABE" BEFEHLAUSGABE=-1 CASE "VER" PRINT "DOS" CASE "COMMAND.COM" CASE "IF" SELECT CASE SpeicherTyp(Position+1) CASE "SF$" VERGLEICHTYP=1 VERGLEICH1$=FunctionDos$("SF$") TYPWERT=0 CASE "ZW%" VERGLEICHTYP=2 VERGLEICH1$=LTRIM$(STR$(VAL(FunctionDos$("ZW%")))) TYPWERT=-1 CASE ELSE EXIT FUNCTION END SELECT SELECT CASE TYPWERT CASE 0 IF VERGLEICHTYP<>1 THEN EXIT FUNCTION VERGLEICH2$=FunctionDos$("SF$") CASE -1 IF VERGLEICHTYP<>2 THEN EXIT FUNCTION VERGLEICH2$=LTRIM$(STR$(VAL(FunctionDos$("ZW%")))) END SELECT CASE "THEN" SELECT CASE VERGLEICH CASE 1 IF TYPWERT=0 THEN IF VERGLEICH1$=VERGLEICH2$ THEN Bedingung=-1 ELSE IF VAL(VERGLEICH1$)=VAL(VERGLEICH2$) THEN Bedingung=-1 END IF CASE 2 IF TYPWERT=0 THEN IF VERGLEICH1$>=VERGLEICH2$ THEN Bedingung=-1 ELSE IF VAL(VERGLEICH1$)>=VAL(VERGLEICH2$) THEN Bedingung=-1 END IF CASE 3 IF TYPWERT=0 THEN IF VERGLEICH1$=VERGLEICH2$ THEN Bedingung=-1 ELSE IF VAL(VERGLEICH1$)<>VAL(VERGLEICH2$) THEN Bedingung=-1 END IF END SELECT VERGLEICH=0 case "LET" INCR Position SELECT CASE SpeicherTyp(Position) CASE "%" V(VAL(FunctionDos$("%WZ")))=VAL(FunctionDos$("%WZ")) CASE "$" S$(VAL(FunctionDos$("%WZ")))=FunctionDos$("SF$") CASE ELSE FHLER=1 EXIT FUNCTION END SELECT case "LETWERT" INCR Position V(VAL(FunctionDos$("%WZ")))=VAL(FunctionDos$("%WZ")) CASE "DRUCKERFARBE" SELECT CASE UCASE$(FunctionDos$("SF")) CASE "SCHWARZ" DRUCKERFARBE%=0 CASE "ROSA" DRUCKERFARBE%=1 CASE "BLAU" DRUCKERFARBE%=2 CASE "LILA" DRUCKERFARBE%=3 CASE "GELB" DRUCKERFARBE%=4 CASE "ROT" DRUCKERFARBE%=5 CASE "GR숹" DRUCKERFARBE%=6 END SELECT CASE ELSE END SELECT CASE "B" 'BEFEHL ohne parameter SELECT CASE UCASE$(Speicher(Position)) CASE "PAUSE" SLEEP CASE "BEEP" BEEP CASE "CLS" CLS CASE "FILES" FILES CASE "EXIT","ENDE","END" EXITDOS=-1 END SELECT EXIT FUNCTION CASE "L" CASE ELSE DOSFEHLER=5 END SELECT END function FUNCTION FunctionDos$(byval WERTB AS STRING) INCR Position DIM rFunctionDos As string ALTPosition=Position SELECT CASE SpeicherTyp(Position) CASE "Z" 'ZAHL rFunctionDos=LTRIM$(STR$(VAL(Speicher$(Position)))) CASE "S" 'STRING rFunctionDos=Speicher$(Position) CASE "W" 'WERT SpeicherTyp(Position)="Z" SELECT CASE UCASE$(Speicher$(Position)) CASE "FRAC%" rFunctionDos=LTRIM$(STR$(FRAC(VAL(FunctionDos$("ZW"))))) CASE "FIX%" rFunctionDos=LTRIM$(STR$(FIX(VAL(FunctionDos$("ZW"))))) CASE "SQR%" rFunctionDos=LTRIM$(STR$(SQR(VAL(FunctionDos$("ZW"))))) CASE "ASC%" rFunctionDos=LTRIM$(STR$(ASCII(FunctionDos$("S")))) CASE "DRUCKERFARBE%" rFunctionDos=LTRIM$(STR$(DRUCKERFARBE%)) CASE "RND%" rFunctionDos=LTRIM$(STR$(RND)) CASE "INSTAT%" rFunctionDos=LTRIM$(STR$(INSTAT)) CASE "LFN%" rFunctionDos=LTRIM$(STR$(LFNSupport%)) CASE "EXIST%" rFunctionDos=LTRIM$(STR$(EXIST(FunctionDos$("SF")))) CASE "TIMER" rFunctionDos=LTRIM$(STR$(TIMER)) CASE"ABS%" rFunctionDos=LTRIM$(STR$(ABS(VAL(FunctionDos$("ZW"))))) CASE"FEHLER%" rFunctionDos=LTRIM$(STR$(ABS(FEHLER))) END SELECT CASE "F" SpeicherTyp(Position)="S" SELECT CASE UCASE$(Speicher$(Position)) CASE "BOOT$" rFunctionDos=GetBootDrive$+":\" CASE "GETBOOTDRIVE$" rFunctionDos=GetBootDrive$ CASE "CURDIR$" IF MID$(CURDIR$,LEN(CURDIR$),1)<>"\" THEN rFunctionDos=CURDIR$+"\" ELSE rFunctionDos=CURDIR$ END IF CASE "DOS83PFAD" rFunctionDos$=DOS83PFAD$(FunctionDos$("SF")) CASE "WIN95PFAD" rFunctionDos$=WIN95PFAD$(FunctionDos$("SF")) CASE "ENVIRON$" rFunctionDos$=ENVIRON$(FunctionDos$("SF")) CASE "DIR$" rFunctionDos$=DIR$ CASE "DIR$(" rFunctionDos$=DIR$(FunctionDos$("SF"),VAL(FunctionDos$("ZW"))) CASE "COMSPEC$" rFunctionDos=COMSPEC$ CASE "COMMAND$" rFunctionDos=PARAMETER$ CASE "MAINNAME$" rFunctionDos=MAINNAME$ CASE "PATH$" rFunctionDos=PATH$ CASE "DATE$" rFunctionDos=DATE$ CASE "TIME$" rFunctionDos=TIME$ CASE "DRUCKER$" rFunctionDos=DRUCKER$ CASE "UCASE$" rFunctionDos$=UCASE$(FunctionDos$("SF")) CASE "LCASE$" rFunctionDos$=LCASE$(FunctionDos$("SF")) CASE "TRIM$" rFunctionDos$=TRIM$(FunctionDos$("SF")) CASE "VARNAMES$" rFunctionDos=SNAME$(VAL(FunctionDos$("ZW"))) CASE "VARNAMEN$" rFunctionDos=VNAME$(VAL(FunctionDos$("ZW"))) CASE "DRUCKERFARBE$" SELECT CASE DRUCKERFARBE% CASE 0 rFunctionDos="SCHWARZ" CASE 1 rFunctionDos="ROSA" CASE 2 rFunctionDos="BLAU" CASE 3 rFunctionDos="LILA" CASE 4 rFunctionDos="GELB" CASE 5 rFunctionDos="ROT" CASE 6 rFunctionDos="GR숹" END SELECT CASE "INKEY$" EINGABE$=INKEY$ IF LEN(EINGABE$)<2 THEN rFunctionDos=MID$(STR$(ASCII(EINGABE$)),2) ELSE rFunctionDos="-"+MID$(STR$(ASCII(MID$(EINGABE$,2,1))),2) END IF CASE "INPUT$" EINGABE$=INPUT$(1) IF LEN(EINGABE$)<2 THEN rFunctionDos=MID$(STR$(ASCII(EINGABE$)),2) ELSE rFunctionDos="-"+MID$(STR$(ASCII(MID$(EINGABE$,2,1))),2) END IF CASE "TASTE$" EINGABE$=INKEY$ IF LEN(EINGABE$)<2 THEN rFunctionDos=EINGABE$ END IF END SELECT CASE "%" INCR Position rFunctionDos=LTRIM$(STR$(V(VAL(FunctionDos$("%WZ"))))) CASE "$" INCR Position rFunctionDos=S$(VAL(FunctionDos$("%WZ"))) CASE ELSE DOSFEHLER=5 END SELECT IF SpeicherTyp(Position+1)="M" THEN SELECT CASE Speicher$(Position+1) CASE "+" SELECT CASE SpeicherTyp(ALTPosition) CASE "Z" INCR Position rFunctionDos=LTRIM$(STR$(VAL(rFunctionDos)+VAL(FunctionDos$("ZW")))) CASE "S" INCR Position rFunctionDos=rFunctionDos+FunctionDos$("SF") CASE ELSE EXIT FUNCTION END SELECT CASE "-" SELECT CASE SpeicherTyp(ALTPosition) CASE "Z" INCR Position rFunctionDos=LTRIM$(STR$(VAL(rFunctionDos)-VAL(FunctionDos$("ZW")))) CASE "S" EXIT FUNCTION END SELECT CASE "*" SELECT CASE SpeicherTyp(ALTPosition) CASE "Z" INCR Position rFunctionDos=LTRIM$(STR$(VAL(rFunctionDos)*VAL(FunctionDos$("ZW")))) CASE "S" EXIT FUNCTION END SELECT CASE "/" SELECT CASE SpeicherTyp(ALTPosition) CASE "Z" INCR Position rFunctionDos=LTRIM$(STR$(VAL(rFunctionDos)/VAL(FunctionDos$("ZW")))) CASE "S" EXIT FUNCTION END SELECT END SELECT END IF FunctionDos$=rFunctionDos END FUNCTION $IF 0 CLS BEEP PAUSE EXIT + - * / Z S 1 PRINT 2 LPRINT 3 COMMAND 4 COMSPEC 5 DATE 6 FILES 7 PLAY 8 DRUCKERFARBE 9 DRUCKERFARBWERT 1 FIX% 2 SQR% 3 ASC% 4 DRUCKERFARBE% 5 RND% 6 INSTAT% 7 LFN% 8 EXIST% 9 TIMER 1 BOOT$ 2 GETBOOTDRIVE$ 3 CURDIR$ 4 ENVIRON$ 5 DIR$ 6 DIR$( 7 COMSPEC$ 8 COMMAND$ 9 MAINNAME$ 10 PATH$ 11 DATE$ 12 TIME$ 13 DRUCKER$ 14 DRUCKERFARBE$ 15 INKEY$ 16 INPUT$ 17 TASTE$ $ENDIF FUNCTION GetBootDrive$ 'Returns the drive the system was last re-booted from as a letter plus 'a colon, eg, C: or A: REG 1, &H3305 CALL INTERRUPT &H21 GetBootDrive$ = CHR$((Reg(4) MOD 256) + 64) END FUNCTION FUNCTION Win95Open$(BYVAL Filename$) Filename$ = Filename$ + CHR$(0) ! push ds ! les di, Filename$ ; Handle von Filename$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; Quelle auf DS:SI umkopieren ! mov si, ax ; ! mov ax, &h716C ! mov bx, &h0002 ! mov cx, &h0000 ! mov dx, &h0012 ! mov di, 1 ! int &h21 ! pop ds ! mov bx, ax ; und File wieder schliessen ! mov ah, &h3E ! int &h21 Win95Open$ = Dos83Pfad$(Filename$) END FUNCTION FUNCTION FileCopy%(BYVAL Source$, BYVAL Destination$) public LOCAL SourceHandle%, DestinationHandle% LOCAL FileDate%, FileTime% LOCAL BufferLenght% LOCAL LFN% LFN% = LFNSupport% ' SELECT CASE LFN% ' LOCATE , 3 ' CASE 1 : PRINT "LFN Support enabled" ' CASE ELSE: PRINT "LFN Support not found" 'END SELECT ' LOCATE , 3: PRINT ' LOCATE , 3: PRINT "Kopiere/Copying: ";Source$ ' LOCATE , 3: PRINT " nach/to: ";Destination$ ' LOCATE , 3 '*** Variablen Init *** Source$ = Source$ + CHR$(0) Destination$ = Destination$ + CHR$(0) BufferLenght% = 32000 Copy$ = STRING$(BufferLenght%, 0) '*** Source-Datei 봣fnen / open sourcefile *** IF LFN% = 0 THEN ! push ds ! les di, Source$ ; Handle von Source$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; DX:AX auf DS:DX umkopieren ! mov dx, ax ; ! mov ax, &h3d90 ; DOS Open ! int &h21 ! pop ds ELSE ! push ds ! les di, Source$ ; Handle von Source$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; Quelle auf DS:SI umkopieren ! mov si, ax ; ! mov ax, &h716C ; Windows95 Open ! mov bx, &h0000 ! mov cx, &h0000 ! mov dx, &h0001 ! mov di, 1 ! int &h21 ! pop ds END IF ! jnc SourceFileOpenOk ! mov FUNCTION, ax ! jmp FileCopyExit SourceFileOpenOk: ! mov SourceHandle%, ax '*** Destination-Datei 봣fnen / open destination file *** IF LFN% = 0 THEN ! push ds ! les di, Destination$ ; Handle von Destination$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; DX:AX auf DS:DX umkopieren ! mov dx, ax ; ! mov ax, &h3c00 ! mov cx, &h0 ! int &h21 ! pop ds ELSE ! push ds ! les di, Destination$ ; Handle von Source$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; Quelle auf DS:SI umkopieren ! mov si, ax ; ! mov ax, &h716C ; Windows95 Open ! mov bx, &h0002 ! mov cx, &h0000 ! mov dx, &h0012 ! mov di, 1 ! int &h21 ! pop ds END IF ! mov DestinationHandle%, ax ! jnc DestinationFileOpenOk ! mov FUNCTION, ax ! jmp FileCopyExit DestinationFileOpenOk: '*** Source-Datei einlesen / read sourcefile *** DO WHILE BufferLenght% = 32000 PRINT "."; ! push ds ! les di, Copy$ ; Handle von Copy$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; DX:AX auf DS:DX umkopieren ! mov dx, ax ; ! mov ax, &h3F00 ! mov bx, SourceHandle% ! mov cx, BufferLenght% ! int &h21 ! pop ds ! mov BufferLenght%, ax ! jnc ReadOk ! mov FUNCTION, ax ! jmp FileCopyExit ReadOk: '*** Destination-Datei schreiben / write destination file *** ! push ds ! les di, Copy$ ; Handle von Copy$ holen ! push di ; auf Stack ! call GetStrLoc ; Adresse holen ! mov ds, dx ; DX:AX auf DS:DX umkopieren ! mov dx, ax ; ! mov ax, &h4000 ! mov bx, DestinationHandle% ! mov cx, BufferLenght% ! int &h21 ! pop ds ! mov BufferLenght%, ax ! jnc WriteOk ! mov FUNCTION, ax ! jmp FileCopyExit WriteOk: LOOP '*** Quelle-Datei Datum lesen / read time/date *** ! mov ax, &h5700 ! mov bx, SourceHandle% ! int &h21 ! mov FileTime%, cx ! mov FileDate%, dx ! jnc ReadTimeStampOk ! mov FUNCTION, ax ! jmp FileCopyExit ReadTimeStampOk: '*** Ziel-Datei Datum schreiben / write date/time *** ! mov ax, &h5701 ! mov bx, DestinationHandle% ! mov cx, FileTime% ! mov dx, FileDate% ! int &h21 ! jnc WriteTimeStampOk ! mov FUNCTION, ax ! jmp FileCopyExit WriteTimeStampOk: '*** Quelle- & Destination-Datei schlie�en / close files *** CloseAllFiles: ! mov ax, &h3E00 ! mov bx, SourceHandle% ! int &h21 ! mov ax, &h3E00 ! mov bx, DestinationHandle% ! int &h21 ! mov FUNCTION, 0 FileCopyExit: END FUNCTION FUNCTION TRIM$(BYVAL TheString$) ' Trims off leading and trailing spaces from a string ' No modifications are made to TheString$ ' Example A$ = TRIM$(" Test ") Sets A$ equal to "Test" TRIM$ = LTRIM$(RTRIM$(TheString$)) END FUNCTION '=========================================================================== ' ScrollUp - einen definierten Bereich des Bildschirms nach oben Rollen ' ' Row = Start-Zeile des Rollbereichs ' Col = Start-Spalte ' Rows = Zeilenanzahl des Rollbereichs (mu� >= 1 sein) ' Cols = Spaltenanzahl (mu� >= 1 sein) ' Attr = Farbattribut f걊 die neuen Leerzeilen ' HowMany = Anzahl der Zeilen, um die gerollt werden soll ' SUB ScrollUp(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, _ BYVAL Rows AS INTEGER, BYVAL Cols AS INTEGER, _ BYVAL Attr AS INTEGER, BYVAL HowMany AS INTEGER) DECR Col ' Spalten zur Basis 0 umrechnen DECR Row ' Zeilen zur Basis 0 umrechnen INCR Rows, Row -1 ' Zeilenanzahl zur letzten Zeile umrechnen INCR Cols, Col -1 ' Spaltenanzahl zur rechten Spalte umrechnen ! push DS ; DS f걊 PowerBASIC sichern ! mov AH, 6 ; AH = Funktion 6, Scroll Up ! mov AL, HowMany ; AL = Anzahl Rollzeilen ! mov BH, Byte Ptr Attr ; BH = Farbattribut der neuen Zeilen ! mov BL, DS:pbvScrnAPage ; BL = aktuelle Bildschirmseite ! mov CH, Row ; CH = Startzeile ! mov CL, Col ; CL = Startspalte ! mov DH, Rows ; DH = Endzeile ! mov DL, Cols ; DL = Endspalte ! int &H10 ; Aufruf BIOS-Interrupt 10h (VIDEO) ! pop DS ; DS f걊 PowerBASIC sichern END SUB '********************************************************************** FUNCTION LfnAlias (BYVAL Lfn AS STRING) PUBLIC AS STRING '---------------------------------------------------------------------- ' This function returns the alias (short) name for a given long file ' or directory name. If long names are not supported by the system, ' or if the file or directory doesn't exist, the function returns the ' given name unaltered. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- IF LfnSupported2 THEN ' Long file names supported ? DIM Address1 AS STRING PTR DIM Address2 AS STRING PTR DIM Lfn0 AS STRING DIM Sfn AS STRING Lfn0 = Lfn + CHR$(0) Sfn = STRING$(128, 0) ' %MAX_DOS_PATH should be enough, ' but according to Ralf Brown's list ' it could be 128. Address1 = STRPTR32(Lfn0) Address2 = STRPTR32(Sfn) ASM MOV AX, &h7160 ; Get short name ASM MOV CX, &h8001 ; &h80: no expansion of subst drives ' &h01: get short name ASM PUSH DS ASM PUSH ES ASM PUSH SI ASM PUSH DI ASM LDS SI, Address1 ASM LES DI, Address2 ASM INT &h21 ASM POP DI ASM POP SI ASM POP ES ASM POP DS ASM JC L50 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L50: ASM MOV DOSError, AX ; DOS error code IF DOSError = 0 THEN FUNCTION = RTRIM$(Sfn, CHR$(0)) ELSE FUNCTION = Lfn END IF ELSE FUNCTION = Lfn END IF END FUNCTION '********************************************************************** FUNCTION LfnAliasCreate (BYVAL Lfn AS STRING) PUBLIC AS STRING '---------------------------------------------------------------------- ' This function returns the alias (short) name for a given long file ' name. However, if the file doesn't exist but its path does it is ' created. This way the functions simulates the conduct of PowerBasic's ' OPEN command for OUTPUT, APPEND, RANDOM or BINARY, and its BLOAD ' command. ' If the file's path doesn't exist or if the file can't be created the ' function returns the given name unaltered. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- LfnDirFirst Lfn, %FILE_ATTRIBUTE_ALL SELECT CASE DOSError CASE %NO_ERROR FUNCTION = LfnALias(Lfn) ' Get alias name if file exists CASE %ERROR_FILE_NOT_FOUND DIM Address AS STRING PTR DIM Handle AS WORD DIM Lfn0 AS STRING DOSError = 0 Lfn0 = Lfn + CHR$(0) Address = STRPTR32(Lfn0) ! PUSH SI ; Save data segment and pointers ! PUSH DI ! PUSH DS IF LfnSupported2 THEN ' Long file names supported ? ! MOV AX, &h716C ; Win95 function create or open file ! MOV BX, %OPEN_ACCESS_READWRITE + %OPEN_SHARE_COMPATIBLE ! MOV DX, %FILE_CREATE ! LDS SI, Address ; adres van bestandspecificatie ! XOR DI, DI ; no alias hint ELSE ! MOV AH, &h5B ; DOS function create file ! LDS DX, Address ; adres van bestandspecificatie END IF ! MOV CX, %FILE_ATTRIBUTE_NORMAL ! INT &h21 ! POP DS ; Restore data segment and pointers ! POP DI ! POP SI ! JC L51 ; if error carry set and error no in AX ! MOV Handle, AX ! XOR AX, AX ; otherwise AX = 0 L51: ! MOV DOSError, AX ; DOS error code IF DOSError = %NO_ERROR THEN ! MOV AH, &h3E ; Function close file ! MOV BX, Handle ! INT &h21 FUNCTION = LfnALias(Lfn) ' Get alias name if file created ELSE FUNCTION = Lfn ' Return name unaltered if not created END IF CASE ELSE FUNCTION = Lfn ' Return name unaltered if path not found END SELECT END FUNCTION '********************************************************************** FUNCTION LfnChDir (BYVAL Directory AS STRING) PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's CHDIR statement. ' The function returns %TRUE (-1) if all went well, and %FALSE (0) ' otherwise. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM Address AS STRING PTR Directory = Directory + CHR$(0) Address = STRPTR32(Directory) IF LfnSupported2 THEN ' Long file names supported ? ASM MOV AX, &h713B ; Win95 function set actual directory ELSE ASM MOV AH, &h3B ; DOS function set actual directory END IF ASM PUSH DS ASM LDS DX, Address ; address of file name ASM INT &h21 ASM POP DS ASM JC L40 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L40: ASM MOV DOSError, AX ; DOS error code FUNCTION = (DOSError = 0) ' return value END FUNCTION '********************************************************************** FUNCTION LfnCurDir (BYVAL Drive AS STRING) PUBLIC AS STRING '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's CURDIR function. ' If an error is encountered the function returns "" as its value. ' Win95 returns the path all in caps. '---------------------------------------------------------------------- DIM Buffer AS STRING DIM BufAddr AS STRING PTR DIM BufLen AS INTEGER DIM DriveNumber AS BYTE DIM Lfn AS INTEGER IF LEN(Drive) = 0 THEN Drive = CurDrive ELSE Drive = UCASE$(LEFT$(Drive$, 1)) END IF DriveNumber = GetDriveNumber(Drive) Lfn = LfnSupported2 IF Lfn THEN BufLen = %MAX_PATH ELSE BufLen = %MAX_DOS_PATH END IF Buffer = STRING$(BufLen, 0) BufAddr = STRPTR32(Buffer) IF Lfn THEN ' Long file names supported ? ASM MOV AX, &h7147 ; Win95 function get current dir ELSE ASM MOV AH, &h47 ; DOS function get current dir END IF ASM PUSH DS ASM PUSH SI ASM LDS SI, BufAddr ; address of buffer in DS:SI ASM XOR DH, DH ASM MOV DL, DriveNumber ; drive number in DX ASM INT &h21 ASM POP SI ASM POP DS ASM JC L13 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L13: ASM MOV DOSError, AX ; DOS error code IF DOSError THEN FUNCTION = "" ELSE FUNCTION = Drive + ":\" + RTRIM$(Buffer, CHR$(0)) ' the directory path END IF END FUNCTION '********************************************************************** FUNCTION LfnDirAlias () PUBLIC AS STRING '---------------------------------------------------------------------- ' Returns the alternate filename (alias) after a call to LfnDirFirst or ' LfnDirNext has been made. ' On it self it doesn't return a meaningfull result. '---------------------------------------------------------------------- IF LfnSupported2 AND FindHandle <> 0 THEN FUNCTION = RTRIM$(FindData.cAlternateFileName, CHR$(0)) ELSE FUNCTION = "" END IF END FUNCTION '********************************************************************** FUNCTION LfnDirFirst (BYVAL Mask AS STRING, BYVAL Attr AS BYTE) PUBLIC _ AS STRING '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's DIR function, first time. ' If an error is encountered the function returns "" as its value. '---------------------------------------------------------------------- DIM PtrMask AS STRING PTR Mask = Mask + CHR$(0) PtrMask = STRPTR32(Mask) IF LfnSupported2 THEN ' Close a search handle not yet closed IF FindHandle THEN FindClose END IF PtrFindData = VARPTR32(FindData) ' Clean the data structure FindData.cFileName = STRING$(%MAX_PATH, 0) FindData.cAlternateFileName = STRING$(14, 0) ASM MOV AX, &h714E ASM MOV CL, Attr ; search attributes ASM TEST CL, %FILE_ATTRIBUTE_VOLUME ; volume attribute included? ASM JZ L20 ; then ASM MOV CH, %FILE_ATTRIBUTE_VOLUME ; only volume names match ASM JMP SHORT L21 L20: ' otherwise ASM OR CL, %FILE_ATTRIBUTE_READONLY ; include read-only files ASM ; as does PB's DIR$ ASM MOV CH, %FILE_ATTRIBUTE_NORMAL ; and all files match L21: ASM PUSH DS ; preserve registers ASM PUSH SI ASM PUSH DI ASM MOV SI, 1 ; MS-DOS date- and time format ASM LES DI, PtrFindData ; Address of Win32_Find_Data structure ASM ; receiving the file info ASM LDS DX, PtrMask ; address of file mask ASM INT &h21 ASM POP DI ASM POP SI ASM POP DS ASM JC L22 ; everything OK? ASM MOV FindHandle, AX ; then save search handle ASM XOR AX, AX ; no error L22: ASM MOV DOSError, AX ; DOS error code IF DOSError THEN FindCLose ' close the find procedure FUNCTION = "" ELSE FUNCTION = RTRIM$(FindData.cFileName, CHR$(0)) ' the file name END IF ELSE GetDTA ' Get addres of DTA @DTA.fiFileName = STRING$(13, 0) ' Clean the data structure ASM MOV AH, &h4E ASM MOV CL, Attr ; search attributes ASM OR CL, %FILE_ATTRIBUTE_READONLY ; include read-only files ASM ; as does PB's DIR$ ASM XOR CH, CH ASM PUSH DS ; preserve registers ASM LDS DX, PtrMask ; address of file mask ASM INT &h21 ASM POP DS ASM JC L23 ; everything OK? ASM XOR AX, AX ; no error L23: ASM MOV DOSError, AX ; DOS error code IF DOSError THEN FUNCTION = "" ELSE FUNCTION = RTRIM$(@DTA.fiFileName, CHR$(0)) ' the file name END IF END IF END FUNCTION '********************************************************************** FUNCTION LfnDirNext () PUBLIC AS STRING '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's DIR function, next times. ' If an error is encountered the function returns "" as its value. '---------------------------------------------------------------------- IF LfnSupported2 THEN ' Clean the data structure FindData.cFileName = STRING$(%MAX_PATH, 0) FindData.cAlternateFileName = STRING$(14, 0) ASM MOV AX, &h714F ASM MOV BX, FindHandle ASM PUSH SI ; preserve registers ASM PUSH DI ASM MOV SI, 1 ; MS-DOS date- and time format ASM LES DI, PtrFindData ; Address of Win32_Find_Data structure ASM ; receiving the file info ASM INT &h21 ASM POP DI ASM POP SI ASM JC L24 ; everything OK? ASM XOR AX, AX ; signal no error L24: ' if error ASM MOV DOSError, AX ; DOS error code IF DOSError THEN FindCLose ' close the find procedure FUNCTION = "" ELSE FUNCTION = RTRIM$(FindData.cFileName, CHR$(0)) ' the file name END IF ELSE GetDTA ' Get addres of DTA @DTA.fiFileName = STRING$(13, 0) ' Clean the data structure ASM MOV AH, &h4F ASM INT &h21 ASM JC L25 ; everything OK? ASM XOR AX, AX ; no error L25: ASM MOV DOSError, AX ; DOS error code IF DOSError THEN FUNCTION = "" ELSE FUNCTION = RTRIM$(@DTA.fiFileName, CHR$(0)) ' the file name END IF END IF END FUNCTION '********************************************************************** SUB LfnFiles () PUBLIC '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's FILES statement '---------------------------------------------------------------------- DIM col AS INTEGER DIM File AS STRING IF LfnSupported2 THEN File$ = LfnDirFirst$("*.*", &h10) DO WHILE LEN(File$) PRINT LfnDirAlias$; IF (LfnGetAttrib(File$) AND &h10) THEN PRINT TAB(14); ""; END IF PRINT TAB(22); File$ File$ = LfnDirNext$ LOOP ELSE col = 1 File$ = LfnDirFirst$("*.*", &h10) DO WHILE LEN(File$) IF col > 80 THEN PRINT col = 1 END IF PRINT TAB(col); File$; IF (LfnGetAttrib(File$) AND &h10) THEN PRINT TAB(col + 13); ""; END IF INCR col, 20 File$ = LfnDirNext$ LOOP PRINT END IF PRINT USING$(STRING$(10, "#"), DiskFree("")); " Bytes free" END SUB '********************************************************************** FUNCTION LfnGetAttrib (BYVAL File AS STRING) PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's ATTRIB function. ' If an error is encountered the function returns -1 as its value. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM Address AS STRING PTR FUNCTION = -1 ' Initialize function value File = File + CHR$(0) Address = STRPTR32(File) IF LfnSupported2 THEN ' Long file names supported ? ASM MOV AX, &h7143 ; Win95 function get or set attributes ASM MOV BL, 0 ; action: retrieve attributes ELSE ASM MOV AH, &h43 ; DOS function get or set attributes ASM MOV AL, 0 ; action: retrieve attributes END IF ASM PUSH DS ASM LDS DX, Address ; address of file name ASM INT &h21 ASM POP DS ASM JC L11 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 ASM MOV FUNCTION, CX L11: ASM MOV DOSError, AX ; DOS error code END FUNCTION '********************************************************************** FUNCTION LfnKill (BYVAL File AS STRING) PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's KILL statement. ' The function returns %TRUE (-1) if all went well, and %FALSE (0) ' otherwise. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM Address AS STRING PTR File = File + CHR$(0) Address = STRPTR32(File) ASM PUSH DS ASM PUSH SI IF LfnSupported2 THEN ' Long file names supported ? ASM MOV SI, 1 ; wildcards allowed ASM MOV CH, %FILE_ATTRIBUTE_NORMAL ; must match attrib's ASM MOV CL, %FILE_ATTRIBUTE_NORMAL ; search attrib's ASM MOV AX, &h7141 ; Win95 function delete file ELSE ASM MOV AH, &h41 ; DOS function delete file END IF ASM LDS DX, Address ; address of file name ASM INT &h21 ASM POP SI ASM POP DS ASM JC L10 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L10: ASM MOV DOSError, AX ; DOS error code FUNCTION = (DOSError = 0) ' return value END FUNCTION '********************************************************************** FUNCTION LfnMkDir (BYVAL Directory AS STRING) PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's MKDIR statement. ' The function returns %TRUE (-1) if all went well, and %FALSE (0) ' otherwise. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM Address AS STRING PTR Directory = Directory + CHR$(0) Address = STRPTR32(Directory) IF LfnSupported2 THEN ' Long file names supported ? ASM MOV AX, &h7139 ; Win95 function make directory ELSE ASM MOV AH, &h39 ; DOS function make directory END IF ASM PUSH DS ASM LDS DX, Address ; address of file name ASM INT &h21 ASM POP DS ASM JC L41 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L41: ASM MOV DOSError, AX ; DOS error code FUNCTION = (DOSError = 0) ' return value END FUNCTION '********************************************************************** FUNCTION LfnName (BYVAL OldName AS STRING, BYVAL NewName AS STRING) PUBLIC _ AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's NAME statement. ' The function returns %TRUE (-1) if all went well, and %FALSE (0) ' otherwise. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM OldAddr AS STRING PTR DIM NewAddr AS STRING PTR OldName = OldName + CHR$(0) NewName = NewName + CHR$(0) OldAddr = STRPTR32(OldName) NewAddr = STRPTR32(NewName) IF LfnSupported2 THEN ' Long file names supported ? ASM MOV AX, &h7156 ; Win95 function rename file ELSE ASM MOV AH, &h56 ; DOS function rename file END IF ASM PUSH DS ASM PUSH DI ASM LES DI, NewAddr ; address of new name ASM LDS DX, OldAddr ; address of old name ASM INT &h21 ASM POP DI ASM POP DS ASM JC L12 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L12: ASM MOV DOSError, AX ; DOS error code FUNCTION = (DOSError = 0) ' return value END FUNCTION '********************************************************************** FUNCTION LfnRmDir (BYVAL Directory AS STRING) PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's RMDIR statement. ' The function returns %TRUE (-1) if all went well, and %FALSE (0) ' otherwise. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM Address AS STRING PTR Directory = Directory + CHR$(0) Address = STRPTR32(Directory) IF LfnSupported2 THEN ' Long file names supported ? ASM MOV AX, &h713A ; Win95 function remove directory ELSE ASM MOV AH, &h3A ; DOS function remove directory END IF ASM PUSH DS ASM LDS DX, Address ; address of file name ASM INT &h21 ASM POP DS ASM JC L42 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 L42: ASM MOV DOSError, AX ; DOS error code FUNCTION = (DOSError = 0) ' return value END FUNCTION '********************************************************************** FUNCTION LfnSetAttrib (BYVAL File AS STRING, BYVAL Attribs AS WORD) _ PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Long file name replacement for PowerBasic's ATTRIB statement. ' The function returns %TRUE (-1) if all went well, and %FALSE (0) ' otherwise. ' Of course long file names can be used under Windows 95 only. '---------------------------------------------------------------------- DIM Address AS STRING PTR FUNCTION = -1 ' Initialize function value File = File + CHR$(0) Address = STRPTR32(File) IF LfnSupported2 THEN ' Long file names supported ? ASM MOV AX, &h7143 ; Win95 function get or set attributes ASM MOV BL, 1 ; action: set attributes ELSE ASM MOV AH, &h43 ; DOS function get or set attributes ASM MOV AL, 1 ; action: set attributes END IF ASM MOV CX, Attribs ; the new attributes ASM PUSH DS ASM LDS DX, Address ; address of file name ASM INT &h21 ASM POP DS ASM JC L14 ; if error carry set and error no in AX ASM XOR AX, AX ; otherwise AX = 0 ASM MOV FUNCTION, CX L14: ASM MOV DOSError, AX ; DOS error code FUNCTION = (DOSError = 0) ' return value END FUNCTION '********************************************************************** FUNCTION LfnSupported () PUBLIC AS INTEGER '---------------------------------------------------------------------- ' LfnSupported returns %TRUE (-1) if Windows 95 long file names are ' supported, and %FALSE (0) otherwise ' This is a PUBLIC wrapper for the PRIVATE sub LfnSupported2. '---------------------------------------------------------------------- LfnSupported = LfnSupported2 END FUNCTION FUNCTION LfnSupported2 () PRIVATE AS INTEGER '---------------------------------------------------------------------- ' LfnSupported2 returns %TRUE (-1) if Windows 95 long file names are ' supported, and %FALSE (0) otherwise '---------------------------------------------------------------------- DIM LfnSupport AS STATIC INTEGER ' flag telling if Long File Names ' are supported (1 = supported, ' -1 = not supported) ' Test if function was called already. ' If so, result is in flag LfnSupport IF LfnSupport = 0 THEN IF LfnSupported3 THEN LfnSupport = 1 ELSE LfnSupport = -1 END IF END IF FUNCTION = (LfnSupport > 0) END FUNCTION FUNCTION LfnSupported3 () PRIVATE AS INTEGER '---------------------------------------------------------------------- ' LfnSupported3 returns %TRUE (-1) if Windows 95 long file names are ' supported, and %FALSE (0) otherwise '---------------------------------------------------------------------- DIM DOSVersion AS BYTE ' main DOS version number DIM SystemName AS STRING DIM RootName AS STRING DIM LenSysName AS INTEGER DIM PtrSysName AS STRING PTR DIM PtrRootName AS STRING PTR 'Initialize function value and flag FUNCTION = %FALSE 'Do we have DOS 7 or higher (but not a DOS box under OS/2)? 'N.B.: OS/2 version 2's DOS box has version number 20 ASM XOR BX, BX ;Zero BX ASM MOV AX, &h3306 ;get DOS version (5 or higher) ASM INT &h21 ASM MOV DOSVersion, BL IF DOSVersion < 7 OR DOSVersion >= 20 THEN ' If DOSVersion is 5 or 6 or 0 (DOS 4 or lower), or 20 or higher ' (OS/2), then no long Win95 names EXIT FUNCTION END IF 'Do we have MS-DOS 7? ASM PUSH DS ASM MOV AX, &h4A33 ;function 4A33h ASM INT &h2F ;of ISR 2Fh ASM POP DS ASM CMP AX, 0 ;is AX zeroed? ASM JE L2 ;if not, no MS-DOS 7 EXIT FUNCTION L2: 'Does system support long names? SystemName$ = STRING$(8,0) PtrSysName = STRPTR32(SystemName$) LenSysName = LEN(SystemName$) RootName$ = "C:\" + CHR$(0) PtrRootName = STRPTR32(RootName$) ASM PUSH DS ASM PUSH DI ASM LES DI, PtrSysName ;get address of SystemName in ES:DI ASM MOV CX, LenSysName ; and length in CX ASM LDS DX, PtrRootName ;get address of RootName in DS:DX ASM MOV AX, &h71A0 ;get volume information ASM INT &h21 ASM POP DI ASM POP DS ASM JC L3 ;if OK, FUNCTION = %TRUE 'then long names are supported L3: END FUNCTION '********************************************************************** FUNCTION CurDrive () PUBLIC AS STRING DIM DriveNumber AS BYTE ASM MOV AH, &h19 ; get current disk drive ASM INT &h21 ASM INC AL ASM MOV DriveNumber, AL FUNCTION = CHR$(DriveNumber + 64) END FUNCTION '********************************************************************** FUNCTION DiskFree (BYVAL Drive AS STRING) PUBLIC AS DWORD '---------------------------------------------------------------------- ' Returns the number of free bytes on the given drive. ' If the given drive is invalid, the function returns 0, and DOSError ' has the value 15 (invalid disk drive). '---------------------------------------------------------------------- DIM DriveNumber AS BYTE DIM BytesInSector AS WORD DIM SectorsInCluster AS WORD DIM FreeClusters AS WORD DriveNumber = GetDriveNumber(Drive) ASM MOV AH, &h36 ASM MOV DL, DriveNumber ASM INT &h21 ASM CMP AX, -1 ; invalid disk drive if AX = -1 ASM JE L30 ASM MOV BytesInSector, CX ASM MOV SectorsInCluster, AX ASM MOV FreeClusters, BX FUNCTION = CDWD(FreeClusters) * SectorsInCluster * BytesInSector DOSError = 0 EXIT FUNCTION L30: FUNCTION = 0 DOSError = 15 ' invalid disk drive END FUNCTION '********************************************************************** FUNCTION DOSErr () PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Returns the DOS error code '---------------------------------------------------------------------- FUNCTION = DOSError END FUNCTION '********************************************************************** FUNCTION DOSErrTest () PUBLIC AS INTEGER '---------------------------------------------------------------------- ' Returns the DOS error code, and resets it to zero '---------------------------------------------------------------------- FUNCTION = DOSError DOSError = 0 END FUNCTION '********************************************************************** FUNCTION GetDTA () PUBLIC AS DWORD '---------------------------------------------------------------------- ' Returns a pointer to the DOS FileInfo structure '---------------------------------------------------------------------- ASM MOV AH, &h2F ASM INT &h21 ASM MOV WORD PTR DTA, BX ASM MOV WORD PTR DTA[2], ES FUNCTION = DTA END FUNCTION '********************************************************************** FUNCTION GetPtrFindData () PUBLIC AS DWORD '---------------------------------------------------------------------- ' Returns a pointer to the Win32 FindData structure '---------------------------------------------------------------------- GetPtrFindData = PtrFindData END FUNCTION '********************************************************************** SUB FindCLose () PRIVATE '---------------------------------------------------------------------- ' Closes the long filename find procedure and frees its internal storage. '---------------------------------------------------------------------- ASM MOV AX, &h71A1 ; close find procedure ASM MOV BX, FindHandle ASM INT &h21 FindHandle = 0 END SUB '********************************************************************** FUNCTION GetDriveNumber (Drive AS STRING) PRIVATE AS BYTE '---------------------------------------------------------------------- ' Sets drive number for given drive: ' A or a = 1, B or b = 2 etc. ' If Drive is an empty string the drive number is 0 to designate the ' current drive. If the first character of Drive isn't a letter, the ' drive number is 255 to designate an invalid drive. '---------------------------------------------------------------------- DIM DriveNumber AS INTEGER DriveNumber = ASCII(Drive) SELECT CASE DriveNumber CASE -1 DriveNumber = 0 CASE 65 TO 90 DECR DriveNumber, 64 CASE 97 TO 122 DECR DriveNumber, 96 CASE ELSE DriveNumber = 255 END SELECT FUNCTION = DriveNumber END FUNCTION