Quelltexte/ Codesnippets | | | | Christian Schneider | KompilierenMarkierenSeparierenDef 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
Waitkey
Das Teil hat mich Nerven gekostet. Wie immer ohne Gewähr ;)
Ausführlichere Version mit Infos zu Freigaben folgt. |
| | | | |
| | 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. |
| | | | |
| | Christian Schneider | Erweiterte Version: KompilierenMarkierenSeparierenDef 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 eine klitzekleine Erweiterung:
Shares("Computername_im_Netz")
optionaler Parameter: Computername eines Computers im Netzwerk, gibt dessen Freigaben wieder | ohne Parameter = lokal KompilierenMarkierenSeparierenShares("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
|
| | | | |
| | | Bei mir erscheint danach nur die MsgBox "Fehler" "Fehler" und GridBox bleibt leer. |
| | | | |
| | Christian Schneider | Du hast KompilierenMarkierenSeparieren 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. |
| | | | |
| | | Asche auf mein Haupt, funktioniert (natürlich)!
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 natürlich korrekt behandelt, das Semikolon aber sonst als Befehlstrennungszeichen (wie in c,php,pascal,...) genutzt werden kann: [...] |
| | | | |
| | Christian Schneider | Muss zu meiner Schande gestehen das XPSE für mich noch ein rotes Tuch ist. Hatte bisher nur einige sehr holprige Gehversuche damit.
Auf der ToDo hab ichs aber schon ein Weilchen. |
| | | | |
| | | 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 für Fehler übersieht sodass es wundert, dass es überhaupt lief. xD |
| | | | |
|
Zum QuelltextThemenoptionen | 11.633 Betrachtungen |
ThemeninformationenDieses Thema hat 3 Teilnehmer: |