XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Programmverzeichnis bestimmen
Freundlicherweise von Dieter Zornow per ROC
zur Verfügung gestellt. DANKE!
Def FindFirstFile(2) !KERNEL32,FindFirstFileA
Def FindClose(1) !KERNEL32,FindClose
Declare PFAD$

PROC FINDFILE

    Declare handle&,info#,file#,Name$
    parameters file$
    Filemode 0
    Dim info#,255
    Dim File#,add(len(file$),1)
    String File#,0=file$
    let handle&=FindFirstFile(file#,info#)
    Let Name$=@String$(Info#,44)
    FindClose(handle&)
    Dispose File#
    Dispose info#
    Filemode 2
    Return Name$

ENDPROC

PROC ZERLEGEN

    Declare z%,name$,Pfad$,l1%,l2%,return$
    parameters uebergabe$
    let Pfad$=uebergabe$
    let l1%=@len(uebergabe$)
    Let z%=1

    Whilenot @equ(z%,0)

        let z%=@instr(,uebergabe$)
        let name$=Mid$(uebergabe$,@add(z%,1),@sub(len(uebergabe$),z%))
        let uebergabe$=name$

    wend

    let l2%=@len(name$)
    let uebergabe$=
    let Pfad$=@left$(Pfad$,@sub(l1%,l2%)) mit letztem

    if @gt(@len(Pfad$),3) wenn nicht im Hauptverzeichnis

        inc l2%
        let Pfad$=@left$(Pfad$,@sub(l1%,l2%)) schneide das letzte  ab wahlweise je nach Verwendung

    endif

    let return$=Pfad$+|+name$ unübliches Trennzeichen verwenden
    return return$

ENDPROC

PROC PFAD

    Declare Progpfad$,Progname$,temp$
    zerlegen @par$(0)

    If @equ$(@upper$(@Mid$(@$(0),@Add(@instr(|,@$(0)),1),@sub(@len(@$(0)),@instr(|,@$(0))))),PROFAN.EXE)

        let temp$=@par$(1) *.prf
        zerlegen temp$

    elseif @equ$(@upper$(@Mid$(@$(0),@Add(@instr(|,@$(0)),1),@sub(@len(@$(0)),@instr(|,@$(0))))),PRFRUN32.EXE)

        let temp$=@par$(1) *.prc
        zerlegen temp$

    else

        let temp$=@par$(0) *.exe
        zerlegen temp$

    endif

    let progpfad$=@Upper$(@left$(@$(0),@sub(@instr(|,@$(0)),1)))
    let Progname$=@upper$(@Mid$(@$(0),@Add(@instr(|,@$(0)),1),@sub(@len(@$(0)),@instr(|,@$(0)))))
    Findfile @upper$(temp$)

    If @equ$(@Trim$(@$(0)),)

        let Progpfad$=
        Let Progname$=
        declare tz$,mess$
        let tz$=Dateifehler
        let mess$=Das Programmverzeichnis konnte nicht gefunden werden, bitte
        starten Sie das Programm im eigenen Verzeichnis neu.
        @messagebox(mess$,tz$,16)

    endif

    Return progpfad$

ENDPROC

Beispiel
PFAD Pfad ermitteln
PFAD$=@$(0) Hier nun der korrekte Pfad zum Programm
messagebox(pfad$,Programmverzeichnis:,4160)