Source/ Codesnippets | | | | Christian Schneider | KompilierenMarqueSéparationDef 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. |
| | | | |
| | 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. |
| | | | |
| | Christian Schneider | Erweiterte Version: KompilierenMarqueSéparationDef 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 l'affaire, funktioniert! |
| | | | |
| | 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éparationShares("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
|
| | | | |
| | | chez mir erscheint après seulement qui MsgBox "Fehler" "Fehler" et GridBox bleibt vide. |
| | | | |
| | Christian Schneider | tu as KompilierenMarqueSéparation 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. |
| | | | |
| | | 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: [...] |
| | | | |
| | 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. |
| | | | |
| | | 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 |
| | | | |
|
Zum QuelltextOptions du sujet | 11.749 Views |
Themeninformationencet Thema hat 3 participant: |