Source / code snippets | | | | Christian Schneider | CompileMarkSeparationDef 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
./../Function-References/XProfan/waitkey/'>Waitkey
the part has me nerves cost[ed]. How always without Gewähr ;)
Ausführlichere Version with About releases follows. |
| | | | |
| | Jörg Sellmeyer | You verwendest The Variable Rückgabe&, without tappt im dunkeln To deklarieren. though shining tappt im dunkeln too superfluously To his, there You your of course a Funktionswert zuweist, tappt im dunkeln but later not any more query or verwendest. it should well Shares_Rückgabe& hot. otherwise runs tadellos. |
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11/22/09 ▲ |
| |
| | Christian Schneider | thanks, is korrigiert.
The Return Value ought to only Fehlern interestingly his. |
| | | | |
| | Christian Schneider | Erweiterte Version: CompileMarkSeparationDef 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 thing, functions! |
| | | | |
| | Christian Schneider | Nochmal a klitzekleine expansion:
Shares("Computername_im_Netz")
optionaler Parameter: Computername one computers the network, gives which releases again | without Parameter = pub CompileMarkSeparationShares("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
|
| | | | |
| | | by me appear thereafter only The MsgBox "Fehler" "Fehler" and GridBOX remaining empty. |
| | | | |
| | Christian Schneider | you have CompileMarkSeparation by the names one ongoing Rechners the network supplant (with BS: Win2000+)? ;)
by me runs on 2 Rechnern sowohl pub, as well as the network. |
| | | | |
| | | ash on my master, functions (naturally)!
If you Strings instead of by Semikolon with the Pluszeichen verknüpfst, would it probably too with XPSE "klappen". command, The one Semikolon expect, go naturally correctly treats, the Semikolon but otherwise as Befehlstrennungszeichen (How in c,php,pascal,...) used go can: [...] |
| | | | |
| | Christian Schneider | must To of my blemish confess the XPSE for me another rotes cloth is. having yet only some very holprige Gehversuche so.
on the ToDo Have ichs but already one Weilchen. |
| | | | |
| | | The is too holprig, no question.
If one something new (Prg) starting, then ists meists plainer and verständlicher How I find. though ichs too yet never bereut have, time NEN altes grosses Program so "fit" To make - savage what for Error übersieht so it wundert, that it at all running. xD |
| | | | |
|
Zum QuelltextTopic-Options | 11.876 Views |
Themeninformationenthis Topic has 3 subscriber: |