(1.118)  S'inscrire

Français
Source/ Codesnippets

Ermitteln Freigaben Lokalen Namen

 

Christian
Schneider

KompilierenMarqueSéparation
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

cela partie hat mich Nerven gekostet. comment toujours sans Gewähr ;)

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




Jörg
Sellmeyer
Du verwendest qui Variable Rückgabe&, sans vous trop déclarer. Allerdings scheint vous aussi überflüssig trop son, là Du son zwar une Funktionswert zuweist, vous mais später pas plus abfragst ou bien verwendest. Es soll wohl Shares_Rückgabe& appeler.
Sonst läufts correcte.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
22.11.2009  ▲
 




Christian
Schneider
merci, ist korrigiert.

qui Rückgabewert sollte seulement chez Fehlern intéressant son.
 
XProfan 11| Vista(64) SP2
22.11.2009  ▲
 




Christian
Schneider
Erweiterte Version:
KompilierenMarqueSéparation
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 l'affaire, funktioniert!
 
23.11.2009  ▲
 




Christian
Schneider
Nochmal une klitzekleine Erweiterung:

Shares("Computername_im_Netz")

optionaler paramètre: Computername eines Computers im Netzwerk, gibt dessen Freigaben wieder | sans paramètre = bistrot
KompilierenMarqueSéparation
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  ▲
 



chez mir erscheint après seulement qui MsgBox "Fehler" "Fehler" et GridBox bleibt vide.
 
24.11.2009  ▲
 




Christian
Schneider
tu as
KompilierenMarqueSéparation
"Computername_im_Netz"
>
par den Namen eines laufenden Rechners im Netzwerk ersetzt (avec BS: Win2000+)? ;)

chez mir läufts sur 2 Rechnern sowohl bistrot, comme aussi im Netzwerk.
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



Asche sur mon tête, funktioniert (naturellement)!

si Du Cordes statt per Semikolon avec dem Pluszeichen verknüpfst, serait es wahrscheinlich aussi avec XPSE "klappen". Befehle, qui un Semikolon erwarten, volonté naturellement korrekt behandelt, cela Semikolon mais sonst comme Befehlstrennungszeichen (comment dans c,php,pascal,...) genutzt volonté peux:  [...] 
 
24.11.2009  ▲
 




Christian
Schneider
Muss trop meiner déshonneur gestehen cela XPSE pour mich encore un rotes Tuch ist. Hatte bisher seulement quelques très holprige Gehversuche avec cela.

sur qui ToDo hab ego mais déjà un Weilchen.
 
XProfan 11| Vista(64) SP2
24.11.2009  ▲
 



qui ist aussi holprig, aucun Frage.

si on la fois quoi nouveau (Prg) anfängt, ensuite ists meists einfacher et verständlicher comment je find. quoique ego aussi encore nie bereut habe, la fois nen altes grosses Programme avec cela "fit" trop faire - cruelle quoi on pour faute übersieht sodass es wundert, dass es überhaupt lief. xD
 
24.11.2009  ▲
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

11.655 Views

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

Themeninformationen

cet Thema hat 3 participant:

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


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie