(862)  Registro

Italia
Fonte/ Codesnippets

Ermitteln Freigaben Lokalen Namen

 

Christian
Schneider

KompilierenMarkierenSeparieren
Def NetShareEnum(7) !"Netapi32", "NetShareEnum"
DEF CopyMemory(3) !"kernel32","RtlMoveMemory"
DEF NetApiBufferFree(1) !"Netapi32","NetApiBufferFree" Von Windows erstellte Struktur wieder freigeben
Declare Ergebnis$[]

Proc Shares

    Declare Shares_Return$[]
    Declare Shares_cname#
    Dim Shares_cname#,4
    StringW Shares_cname#,0,chr$(0) Local
    Declare Shares_1&,Shares_2&,Shares_bufptr&
    Declare Shares_Name#
    Dim Shares_Name#,80*2+2
    Declare Shares_Rückgabe&
    Shares_Rückgabe&=NetShareEnum(addr(Shares_cname#),0,addr(Shares_bufptr&),-1,addr(Shares_1&),addr(Shares_2&),0)

    IF Shares_Rückgabe& = 234

        Shares_Return$[0]="-1"
        NetApiBufferFree(Shares_bufptr&)

    ElseIF Shares_Rückgabe& <> 0

        Shares_Return$[0]="-1"

    Else

        Whileloop Shares_2&

            CopyMemory(Shares_Name#,Long(Shares_bufptr&+((&loop-1)*4),0),80*2+2)
            Shares_Return$[&loop-1] = left$(StringW$(Shares_Name#,0),len(StringW$(Shares_Name#,0)))

        Endwhile

        NetApiBufferFree(Shares_bufptr&)

    EndIF

    Dispose Shares_cname#,Shares_Name#
    Return Shares_Return$[]

Endproc

Ergebnis$[]=Shares()

IF Ergebnis$[0] <> "-1"

    Whileloop sizeof(Ergebnis$[])

        Print Ergebnis$[&loop-1]

    EndWhile

Else

    Print "Fehler"

EndIF

./../funktionsreferenzen/xprofan/waitkey/'>Waitkey

Das Teil hat mich Nerven gekostet. Wie immer ohne Gewähr ;)

Ausführlichere Version mit Infos zu Freigaben folgt.
 
XProfan 11| Vista(64) SP2
22.11.2009  ▲
 




Jörg
Sellmeyer
Du verwendest die Variable Rückgabe&, ohne sie zu deklarieren. Allerdings scheint sie auch überflüssig zu sein, da Du ihr zwar einen Funktionswert zuweist, sie aber später nicht mehr abfragst oder verwendest. Es soll wohl Shares_Rückgabe& heißen.
Sonst läufts tadellos.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
22.11.2009  ▲
 




Christian
Schneider
Danke, ist korrigiert.

Der Rückgabewert sollte nur bei Fehlern interessant sein.
 
XProfan 11| Vista(64) SP2
22.11.2009  ▲
 




Christian
Schneider
Erweiterte Version:
KompilierenMarkierenSeparieren
Def NetShareEnum(7) !"Netapi32", "NetShareEnum"
DEF CopyMemory(3) !"kernel32","RtlMoveMemory"
DEF NetApiBufferFree(1) !"Netapi32","NetApiBufferFree" Von Windows erstellte Struktur wieder freigeben
Declare Ergebnis$[]

Proc Shares

    Declare Shares_Return$[],Shares_cname#,Shares_1&,Shares_2&,Shares_bufptr&,Shares_Name#,Shares_Rückgabe&
    Var Shares_Lauf&=1
    Dim Shares_cname#,4
    StringW Shares_cname#,0,chr$(0) Local
    Dim Shares_Name#,256*2+2
    Shares_Rückgabe&=NetShareEnum(addr(Shares_cname#),1,addr(Shares_bufptr&),-1,addr(Shares_1&),addr(Shares_2&),0)

    IF Shares_Rückgabe& = 234

        Shares_Return$[0]="-1"
        NetApiBufferFree(Shares_bufptr&)

    ElseIF Shares_Rückgabe& <> 0

        Shares_Return$[0]="-1"

    Else

        Whileloop Shares_2&*3

            IF Shares_Lauf& = 1

                CopyMemory(Shares_Name#,Long(Shares_bufptr&+((&loop-1)*4),0),80*2+2) Name
                Shares_Return$[&loop-1] = left$(StringW$(Shares_Name#,0),len(StringW$(Shares_Name#,0))) Name
                Inc Shares_Lauf&

            ElseIF Shares_Lauf& = 2

                CopyMemory(Shares_Name#,(Shares_bufptr&+((&loop-1)*4)),4) Typ
                Shares_Return$[&loop-1] = str$(Byte(Shares_Name#,0));",";str$(Byte(Shares_Name#,3)) Typ
                Inc Shares_Lauf&

            Else

                CopyMemory(Shares_Name#,Long(Shares_bufptr&+((&loop-1)*4),0),256*2) Beschreibung
                Shares_Return$[&loop-1] = left$(StringW$(Shares_Name#,0),len(StringW$(Shares_Name#,0))), Beschreibung
                Dec Shares_Lauf&,2

            EndIF

        Endwhile

        NetApiBufferFree(Shares_bufptr&)

    EndIF

    Dispose Shares_cname#,Shares_Name#
    Return Shares_Return$[]

Endproc

Proc Share_Typ

    Parameters Share_Typ_in$
    Declare Share_Typ_out$

    IF val(SubStr$(Share_Typ_in$,1,",")) = 0

        Share_Typ_out$="Verzeichnis"

    ElseIF val(SubStr$(Share_Typ_in$,1,",")) = 1

        Share_Typ_out$="Drucker"

    ElseIF val(SubStr$(Share_Typ_in$,1,",")) = 2

        Share_Typ_out$="Communication-Device"

    ElseIF val(SubStr$(Share_Typ_in$,1,",")) = 3

        Share_Typ_out$="IPC"

    EndIF

    IF val(SubStr$(Share_Typ_in$,2,",")) > 0

        Share_Typ_out$=Share_Typ_out$;" + Standardfreigabe"

    EndIF

    Return Share_Typ_out$

Endproc

Declare Gridbox&,Füllen$
Var Pos&=1
Ergebnis$[]=Shares()
Window 100,100-845,500
Gridbox&=@Create("GridBox",%hwnd,"Name;0;200;Typ;0;200;Beschreibung;0;380",0,15,15,800,400)

IF Ergebnis$[0] <> "-1"

    Füllen$=Ergebnis$[0];"|";Share_Typ(Ergebnis$[1]);"|";@If(Ergebnis$[&loop*3+2]=" ",">Keine Beschreibung vorhanden<",Ergebnis$[&loop*3+2])
    AddString(Gridbox&,Füllen$)

    Whileloop sizeof(Ergebnis$[])/3-1

        Füllen$=Ergebnis$[&loop*3];"|";Share_Typ(Ergebnis$[&loop*3+1]);"|";@If(Ergebnis$[&loop*3+2]=" ",">Keine Beschreibung vorhanden<",Ergebnis$[&loop*3+2])
        AddString(Gridbox&,Füllen$)

    EndWhile

Else

    Messagebox("Fehler","Fehler",0)

EndIF

Waitkey
 
XProfan 11| Vista(64) SP2
23.11.2009  ▲
 



Super Sache, funktioniert!
 
23.11.2009  ▲
 




Christian
Schneider
Nochmal eine klitzekleine Erweiterung:

Shares("Computername_im_Netz")

optionaler Parameter: Computername eines Computers im Netzwerk, gibt dessen Freigaben wieder | ohne Parameter = lokal
KompilierenMarkierenSeparieren
Shares("Computername_im_Netz") durch Rechnernamen im Netzwerk ersetzen, oder Parameter weglassen für lokale Freigaben
Def NetShareEnum(7) !"Netapi32", "NetShareEnum"
DEF CopyMemory(3) !"kernel32","RtlMoveMemory"
DEF NetApiBufferFree(1) !"Netapi32","NetApiBufferFree" Von Windows erstellte Struktur wieder freigeben
Declare Ergebnis$[]

Proc Shares

    Parameters Shares_cname$
    Declare Shares_Return$[],Shares_cname#,Shares_1&,Shares_2&,Shares_bufptr&,Shares_Name#,Shares_Rückgabe&
    Var Shares_Lauf&=1
    Dim Shares_cname#,len(Shares_cname$)*2+2
    StringW Shares_cname#,0,Shares_cname$ Local
    Dim Shares_Name#,256*2+2
    Shares_Rückgabe&=NetShareEnum(addr(Shares_cname#),1,addr(Shares_bufptr&),-1,addr(Shares_1&),addr(Shares_2&),0)

    IF Shares_Rückgabe& = 234

        Shares_Return$[0]="-1"
        NetApiBufferFree(Shares_bufptr&)

    ElseIF Shares_Rückgabe& <> 0

        Shares_Return$[0]="-1"

    Else

        Whileloop Shares_2&*3

            IF Shares_Lauf& = 1

                CopyMemory(Shares_Name#,Long(Shares_bufptr&+((&loop-1)*4),0),80*2+2) Name
                Shares_Return$[&loop-1] = left$(StringW$(Shares_Name#,0),len(StringW$(Shares_Name#,0))) Name
                Inc Shares_Lauf&

            ElseIF Shares_Lauf& = 2

                CopyMemory(Shares_Name#,(Shares_bufptr&+((&loop-1)*4)),4) Typ
                Shares_Return$[&loop-1] = str$(Byte(Shares_Name#,0));",";str$(Byte(Shares_Name#,3)) Typ
                Inc Shares_Lauf&

            Else

                CopyMemory(Shares_Name#,Long(Shares_bufptr&+((&loop-1)*4),0),256*2) Beschreibung
                Shares_Return$[&loop-1] = left$(StringW$(Shares_Name#,0),len(StringW$(Shares_Name#,0))), Beschreibung
                Dec Shares_Lauf&,2

            EndIF

        Endwhile

        NetApiBufferFree(Shares_bufptr&)

    EndIF

    Dispose Shares_cname#,Shares_Name#
    Return Shares_Return$[]

Endproc

Proc Share_Typ

    Parameters Share_Typ_in$
    Declare Share_Typ_out$

    IF val(SubStr$(Share_Typ_in$,1,",")) = 0

        Share_Typ_out$="Verzeichnis"

    ElseIF val(SubStr$(Share_Typ_in$,1,",")) = 1

        Share_Typ_out$="Drucker"

    ElseIF val(SubStr$(Share_Typ_in$,1,",")) = 2

        Share_Typ_out$="Communication-Device"

    ElseIF val(SubStr$(Share_Typ_in$,1,",")) = 3

        Share_Typ_out$="IPC"

    EndIF

    IF val(SubStr$(Share_Typ_in$,2,",")) > 0

        Share_Typ_out$=Share_Typ_out$;" + Standardfreigabe"

    EndIF

    Return Share_Typ_out$

Endproc

Declare Gridbox&,Füllen$
Var Pos&=1
Ergebnis$[]=Shares("Computername_im_Netz")
Window 100,100-845,500
Gridbox&=@Create("GridBox",%hwnd,"Name;0;200;Typ;0;200;Beschreibung;0;380",0,15,15,800,400)

IF Ergebnis$[0] <> "-1"

    Füllen$=Ergebnis$[0];"|";Share_Typ(Ergebnis$[1]);"|";@If(Ergebnis$[&loop*3+2]=" ",">Keine Beschreibung vorhanden<",Ergebnis$[&loop*3+2])
    AddString(Gridbox&,Füllen$)

    Whileloop sizeof(Ergebnis$[])/3-1

        Füllen$=Ergebnis$[&loop*3];"|";Share_Typ(Ergebnis$[&loop*3+1]);"|";@If(Ergebnis$[&loop*3+2]=" ",">Keine Beschreibung vorhanden<",Ergebnis$[&loop*3+2])
        AddString(Gridbox&,Füllen$)

    EndWhile

Else

    Messagebox("Fehler","Fehler",0)

EndIF

Waitkey
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



Bei mir erscheint danach nur die MsgBox "Fehler" "Fehler" und GridBox bleibt leer.
 
24.11.2009  ▲
 




Christian
Schneider
Du hast
KompilierenMarkierenSeparieren
"Computername_im_Netz"
>
durch den Namen eines laufenden Rechners im Netzwerk ersetzt (mit BS: Win2000+)? ;)

Bei mir läufts auf 2 Rechnern sowohl lokal, als auch im Netzwerk.
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



Asche auf mein Haupt, funktioniert (naturalmente)!

Wenn Du Strings statt per Semikolon mit dem Pluszeichen verknüpfst, würde es wahrscheinlich auch mit XPSE "klappen". Befehle, die ein Semikolon erwarten, werden naturalmente korrekt behandelt, das Semikolon aber sonst als Befehlstrennungszeichen (wie in c,php,pascal,...) genutzt werden kann:  [...] 
 
24.11.2009  ▲
 




Christian
Schneider
Muss zu meiner Schande gestehen das XPSE per mich noch ein rotes Tuch ist. Hatte bisher nur einige sehr holprige Gehversuche damit.

Auf der ToDo hab ichs aber schon ein Weilchen.
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



Der ist auch holprig, keine Frage.

Wenn man mal was neues (Prg) anfängt, dann ists meists einfacher und auch verständlicher wie ich find. Obwohl ichs auch noch nie bereut habe, mal nen altes grosses Programm damit "fit" zu machen - grausam was man per Fehler übersieht sodass es wundert, dass es überhaupt lief. xD
 
24.11.2009  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

11.231 Views

Untitledvor 0 min.
maroro13.04.2018
iF19.05.2013
Christian Schneider17.11.2012

Themeninformationen

Dieses Thema hat 3 subscriber:

Christian Schneider (6x)
iF (4x)
Jörg Sellmeyer (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie