(944)  Registro

Español
Fuente/ Codesnippets

Ermitteln Freigaben Lokalen Namen

 

Christian
Schneider

KompilierenMarcaSeparación
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 ha mich Nerven gekostet. Como siempre sin Gewähr ;)

Ausführlichere Versión con Infos a Freigaben folgt.
 
XProfan 11| Vista(64) SP2
22.11.2009  ▲
 




Jörg
Sellmeyer
Usted verwendest el Variable Rückgabe&, sin ellos a deklarieren. Aunque scheint ellos auch überflüssig a ser, como Usted ihr zwar una Funktionswert zuweist, ellos aber später no mehr abfragst oder verwendest. Lo se 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
Gracias, es korrigiert.

Der Rückgabewert debería sólo en Fehlern interessant ser.
 
XProfan 11| Vista(64) SP2
22.11.2009  ▲
 




Christian
Schneider
Erweiterte Versión:
KompilierenMarcaSeparación
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 una klitzekleine Erweiterung:

Shares("Computername_im_Netz")

optionaler Parámetro: Computername uno Computers en el Netzwerk, son dessen Freigaben otra vez | sin Parámetro = lokal
KompilierenMarcaSeparación
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  ▲
 



En me erscheint danach sólo el MsgBox "Fehler" "Fehler" y GridBox restos leer.
 
24.11.2009  ▲
 




Christian
Schneider
Usted hast
KompilierenMarcaSeparación
"Computername_im_Netz"
>
por el Namen uno laufenden Rechners en el Netzwerk ersetzt (con BS: Win2000+)? ;)

En me läufts en 2 Rechnern sowohl lokal, como auch en el Netzwerk.
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



Asche en mein Haupt, funktioniert (natürlich)!

Si usted Cuerdas en lugar de por Semikolon con el Pluszeichen verknüpfst, sería lo wahrscheinlich auch con XPSE "klappen". Befehle, el una Semikolon esperar, voluntad natürlich korrekt behandelt, el Semikolon aber sonst como Befehlstrennungszeichen (como en c,php,pascal,...) genutzt voluntad kann:  [...] 
 
24.11.2009  ▲
 




Christian
Schneider
Muss a meiner Schande gestehen el XPSE para mich todavía una rotes Tuch es. Hatte bisher sólo algunos muy holprige Gehversuche así.

Auf el ToDo tener ego aber ya una Weilchen.
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



Der es auch holprig, no Cuestión.

Wenn uno algo neues (Prg) anfängt, entonces ists meists einfacher y verständlicher Yo find. Obwohl ego auch todavía nie bereut habe, veces nen altes grosses Programa así "fit" a hacer - grausam qué para Fehler übersieht sodass lo wundert, dass lo überhaupt lief. xD
 
24.11.2009  ▲
 



Zum Quelltext


Título del Tema, max. 100 Signo.
 

Systemprofile:

Kein Systemprofil creado. [anlegen]

XProfan:

 Contribución  Font  Smilies  ▼ 

Bitte registro en una Contribución a verfassen.
 

Tema opciones

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Constantemente
Hecho

11.646 Views

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

Themeninformationen

Dieses Thema ha 3 subscriber:

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


Admins  |  AGB  |  Applications  |  Autores  |  Chat  |  Política de Privacidad  |  Descargar  |  Entrance  |  Ayuda  |  Merchantportal  |  Pie de imprenta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Juegos  |  Búsqueda  |  Support

Ein Projekt aller XProfan, el lo son!


Mi XProfan
Privado Noticias
Eigenes Ablageforum
Temas-Merkliste
Eigene Beiträge
Eigene Temas
Zwischenablage
Cancelar
 Deutsch English Français Español Italia
Traducciones

Política de Privacidad


Wir uso Cookies sólo como Session-Cookies wegen el technischen Notwendigkeit y en uns hay no Cookies de Drittanbietern.

Wenn du hier en unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung de Informationen en unseren Cookies en XProfan.Net a.

Weitere Informationen a unseren Cookies y dazu, como du el Kontrolle darüber behältst, findest du en unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Yo möchte no Cookie