XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Laufwerke identifizieren (Netzlaufwerke finden)
####################################################################
 $P+
SetErrorLevel 0
Declare _dlgLW%, LW_B#, su#
DEF GetDriveType(1) !kernel32.dll,GetDriveTypeA
DEF GetDeviceCaps(2) !GDI32,GetDeviceCaps
Fenster mitteln
DEF @PosX(1) @Int(@Div(@Sub(%MaxX,@%(1)),2))
DEF @PosY(1) @Int(@Div(@Sub(%MaxY,@%(1)),2))
Delete X
DEF GetSystemMenu(2) !USER32,GetSystemMenu
DEF EnableMenuItem(3) !USER32,EnableMenuItem

PROC NetzLW

    DIM LW_B#,5
    DIM su#,5
    Declare z1%, z2%, Drv1$, _f2%, su%, su$, LW$, cmEnde%, Chbox%, _ende%, Hinw%
    LET z1%=0
    LET z2%=65
    LET _f2%=@CreateFont(Arial,15,0,1,0,0)
    windowstyle $10

    IF @GT(GetDeviceCaps(%hdc,$58),96)

        LET _dlgLW%=@createdialog(%Hwnd, Netzlaufwerk-Finder - Version 1.2 - © DRCRR 2002,@PosX(340),@PosY(278),340,278)

    Else

        LET _dlgLW%=@createdialog(%Hwnd, Netzlaufwerk-Finder - Version 1.2 - © DRCRR 2002,@PosX(340),@PosY(270),340,270)

    Endif

    EnableMenuitem(GetSystemMenu(GetActiveWindow(),0),$F060,1)
    UseFont Arial,15,0,1,0,0
    SetDialogFont 1
    TextColor @RGB(0,0,0),-1
    Let Hinw%=@CreateText(_dlgLW%,,24,20,270,20)
    LET ChBox%=CreateChoiceBox(_dlgLW%,,20,70,295,130)
    LET cmEnde%=@createbutton(_dlgLW%,Ende - Sie können nur ein Netzlaufwerk auswählen,15,210,305,30)
    SetFont ChBox%,_f2%
    SetFont cmEnde%,_f2%

    WHILENOT z1%

        LET Drv1$=@Chr$(z2%);:
        String LW_B#,0=Drv1$

        IF @Neq(z2%,91)

            IF @Neq(GetDriveType(LW_B#),1)

                IF @Equ(GetDriveType(LW_B#),0)

                    LET Drv1$=GetDriveType(LW_B#), - LW ,@Chr$(z2%); : ,= unbekannter Typ
                    @AddChoice(ChBox%,Drv1$)

                ELSEIF @Equ(GetDriveType(LW_B#),2)

                    LET Drv1$=GetDriveType(LW_B#), - LW ,@Chr$(z2%); : ,= Diskette / Wechselplatte
                    @AddChoice(ChBox%,Drv1$)

                ELSEIF @Equ(GetDriveType(LW_B#),3)

                    LET Drv1$=GetDriveType(LW_B#), - LW ,@Chr$(z2%); : ,= Festplatte
                    @AddChoice(ChBox%,Drv1$)

                ELSEIF @Equ(GetDriveType(LW_B#),4)

                    LET Drv1$=GetDriveType(LW_B#), - LW ,@Chr$(z2%); : ,= Netzlaufwerk
                    @AddChoice(ChBox%,Drv1$)

                ELSEIF @Equ(GetDriveType(LW_B#),5)

                    LET Drv1$=GetDriveType(LW_B#), - LW ,@Chr$(z2%); : ,= CD-ROM Laufwerk
                    @AddChoice(ChBox%,Drv1$)

                ELSEIF @Equ(GetDriveType(LW_B#),6)

                    LET Drv1$=GetDriveType(LW_B#), - LW ,@Chr$(z2%); : ,= RAM-Disk
                    @AddChoice(ChBox%,Drv1$)

                endif

            endif

            inc z2%

        else

            LET z1%=1

        endif

    Endwhile

    @sendmessage(ChBox%,$014F,1,0)
    String su#,0=4
    LET su%=@SendMessage(ChBox%,$014D,-1,Su#)
    EnableWindow cmEnde%,0

    IF @Gt(su%,-1)

        EnableWindow ChBox%,0
        @sendmessage(ChBox%,$014F,1,0)
        LET su$=@SendMessage(ChBox%,$014D,-1,Su#)
        LET LW$=,Trim$(GetText$(ChBox%)), vorhanden !
        LET su$=Es wurde Netzlaufwerk [,@Mid$(@GetText$(ChBox%),11,3),] gewählt!
        EnableWindow cmEnde%,1
        SetText cmEnde%,su$
        SetText Hinw%,LW$

    ELSE

        SetText Hinw%,K e i n N e t z l a u f w e r k v o r h a n d e n -
        @CreateText(_dlgLW%,wählen Sie zum Beenden bitte ein anderes LW,24,40,270,20)

    ENDIF

    WHILENOT _ende%

        Waitinput

        IF @GetFocus(cmEnde%)

            LET _ende%=1

        ELSEIF @GetFocus(ChBox%)

            LET su$=Ungültig : Es wurde Laufwerk [,@Mid$(@GetText$(ChBox%),11,3),] gewählt!

            IF @Neq$(@GetText$(ChBox%),)

                EnableWindow cmEnde%,1
                SetText cmEnde%,su$

            ENDIF

        ENDIF

    ENDWHILE

    @DestroyWindow(_dlgLW%)
    DISPOSE LW_B#
    DISPOSE su#

ENDPROC

windowtitle  > Netzwerk-Tester <
windowstyle $90
window 0,0-0,0
ShowWindow(%Hwnd,7)
NetzLW
DeleteObject _f2%
End
##########################################