Logo Foltyn Presentation
Table of Contents Previous Page Next Page
Content-Symbol-Img
Ein Programm in der Programmiersprache A program in the programming language
Classic Power Basic for Windows
zum Zeigen des Aufbaus mit Modulen to show the construction with modules

This is: Power BASIC

Das Programmieren beginnt in jeder Sprache mit dem Sammeln von selbstgeschriebenen Modulen, die zusammen die Grundfunktionen von Programmen anbieten, die etwas für den Anwender tun sollen.

Dabei geht es in erster Linie um die Bedienung der Ein- und Ausgabe von Daten auf dem Bildschirm und um alle Arten von Festplatten-Operationen.

Im Power-Basic können Module in einer Include-Datei angeordnet werden, so daß sie vor dem Hauptprogramm versteckt sind.

In Visual Basic hat der Begriff "modules" auch noch eine andere Bedeutung, aber hier handelt es sich um selbst-geschriebene Prozeduren.

The programming starts in every language with collection of self-written modules, which together offer the basic-functions of programs, which are to do anything for the user.

Thereby in the first line it is at stake the control of in- and output of files on the screen and all kinds of hard-disk-operations.

In Power-Basic the modules can be arranged in an include-file, so that they are hidden from the main-program.

In Visual Basic the notion "modules" has another meaning too, but here is all about self-ritten procedures.

Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist
The program ist tested before publication, but there can be given no guarantee, that it is free of errors
30. Sept. 2012 Sept 30th 2012

' ModulesTestPgm.bas

#COMPILE EXE
#DIM ALL

#INCLUDE "SelfMadeModules.INC" ' WIN32API.INC in SelfMadeModuls included

FUNCTION PBMAIN () AS LONG
    CALL DeclareModuleVariables ' From SelfMadeModules.INC
    DIM DriveName AS STRING, DriveLetter AS STRING
    DIM MyFolder AS STRING

    MSGBOX CurrentPath,,"Current Path"

    CALL CreateDriveList(DriveList())
    MSGBOX ">" & JOIN$(DriveList(),$CRLF) & "<",,"DriveList"

    DriveName = MID$(DriveList(0),4)
    DriveLetter = GetDriveLetterFromDriveName(DriveList(),DriveName)
    MSGBOX ">" & DriveLetter & "<",,"DriveLetter"

    MyFolder = "d:\TestFolder\"
    MSGBOX STR$(FolderEmpty(MyFolder)),,"Folder Empty"
END FUNCTION

' SelfMadeModules.INC

#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF

DECLARE FUNCTION GetDriveLetterFromDriveName(AnyArray() AS STRING, STRING) AS STRING
DECLARE FUNCTION FileExists(STRING) AS INTEGER
DECLARE FUNCTION FolderExists(STRING) AS INTEGER
DECLARE FUNCTION FolderEmpty(STRING) AS INTEGER

SUB DeclareModuleVariables
    GLOBAL CurrentPath AS STRING
    GLOBAL DriveList() AS STRING: REDIM DriveList(-1) AS STRING

    CurrentPath = CURDIR$ & "\"
END SUB

FUNCTION GetDriveLetterFromDriveName(AnyArray() AS STRING, AnyName AS STRING) AS STRING
     DIM i&: FUNCTION = ""
     CALL CreateDriveList(AnyArray())
     IF AnyName <> "" THEN
        FOR i& = 0 TO UBOUND(AnyArray)
            IF UCASE$(AnyName) = UCASE$(MID$(AnyArray(i&),4)) THEN
                FUNCTION = LEFT$(AnyArray(i&),3): EXIT FOR
            END IF
        NEXT
     END IF
END FUNCTION

SUB CreateDriveList(BYREF AnyArray() AS STRING)
    DIM i&, sTmp$, DriveName$: sTmp$ = ""
    FOR i& = ASC("A") TO ASC("Z")
         DriveName$ = DIR$(CHR$(i&) & ":\*.*", %VLABEL)
         IF DriveName$ <> "" THEN
            IF sTmp$ <> "" THEN sTmp$ = sTmp$ & ","
            sTmp$ = sTmp$ & CHR$(i&) & ":\" & DriveName$
         END IF
    NEXT: DIM AnyArray(PARSECOUNT(sTmp$)-1)
    PARSE sTmp$, AnyArray(),","
END SUB

SUB WriteArrayToFile(AnyArray() AS STRING, BYVAL AnyFileSpec AS STRING)
    DIM sTmp$: sTmp$ = AnyArray(UBOUND(AnyArray))
    REDIM PRESERVE AnyArray(UBOUND(AnyArray)-1)
    OPEN AnyFileSpec FOR OUTPUT AS #1
        PRINT #1, AnyArray()
        PRINT #1, sTmp$;
    CLOSE #1
END SUB

SUB ReadArrayFromFile(BYREF AnyArray() AS STRING, BYVAL AnyFilSpec AS STRING)
    DIM count&
    OPEN AnyFilSpec FOR INPUT AS #1
        FILESCAN #1, RECORDS TO count&
        DECR count&: REDIM AnyArray(count&)
        LINE INPUT #1, AnyArray() TO count&
    CLOSE #1
END SUB

SUB RemoveEmptyItemsFromArray(BYREF AnyArray() AS STRING)
    DIM i&, UBnd&: i& = 0: UBnd& = UBOUND(AnyArray)
    WHILE i& <= UBnd&
        IF TRIM$(AnyArray(i&)) = "" THEN
            ARRAY DELETE AnyArray(i&): DECR UBnd&: DECR i&
        END IF: INCR i&
    WEND: REDIM PRESERVE AnyArray(UBnd&)
END SUB

FUNCTION FileExists(AnyFileSpec AS STRING) AS INTEGER
    FUNCTION = ISTRUE(LEN(DIR$(AnyFileSpec,%READONLY OR %HIDDEN OR %SYSTEM OR %ARCHIVE)))
END FUNCTION

FUNCTION FolderExists(AnyFolder AS STRING) AS INTEGER
    FUNCTION = ISTRUE(LEN(DIR$(AnyFolder,%SUBDIR)))
END FUNCTION

FUNCTION FolderEmpty(AnyFolder AS STRING) AS INTEGER
    FUNCTION = ISTRUE(DIR$(AnyFolder,%HIDDEN OR %READONLY OR _
    %SYSTEM OR %SUBDIR OR %NORMAL OR %ARCHIVE) = "")
    DIR$ CLOSE
END FUNCTION

SUB GetFiles(BYREF AnyArray() AS STRING, AnyFolder AS STRING)
    LOCAL temp$
    temp$ = DIR$(AnyFolder & "*.*",%READONLY OR %HIDDEN OR %SYSTEM OR %ARCHIVE)
    WHILE LEN(temp$)
        REDIM PRESERVE AnyArray(UBOUND(AnyArray)+1)
        AnyArray(UBOUND(AnyArray)) = temp$
        temp$ = DIR$
    WEND: DIR$ CLOSE
END SUB

SUB GetSubFolders(BYREF AnyArray() AS STRING, AnyFolder AS STRING)
    LOCAL temp$
    temp$ = DIR$(AnyFolder,%HIDDEN OR %READONLY OR %SYSTEM OR %NORMAL OR %ARCHIVE OR %SUBDIR)
    WHILE LEN(temp$)
        IF (GETATTR(AnyFolder & temp$) AND %SUBDIR) = %SUBDIR THEN
            REDIM PRESERVE AnyArray(UBOUND(AnyArray)+1)
            AnyArray(UBOUND(AnyArray)) = temp$
        END IF: temp$ = DIR$
    WEND: DIR$ CLOSE
END SUB