Fuente/ Codesnippets | | | | Christian Schneider | KompilierenMarcaSeparaciónDef 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. |
| | | | |
| | 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. |
| | | | |
| | Christian Schneider | Erweiterte Versión: KompilierenMarcaSeparaciónDef 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
|
| | | | |
| | | Super Sache, funktioniert! |
| | | | |
| | 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ónShares("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
|
| | | | |
| | | En me erscheint danach sólo el MsgBox "Fehler" "Fehler" y GridBox restos leer. |
| | | | |
| | Christian Schneider | Usted hast KompilierenMarcaSeparación 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. |
| | | | |
| | | 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: [...] |
| | | | |
| | 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. |
| | | | |
| | | 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 |
| | | | |
|
Zum QuelltextTema opciones | 11.640 Views |
ThemeninformationenDieses Thema ha 3 subscriber: |