Ordner im Netzwerk freigeben |
|
| System | Win9x, WinNT, Win2000, WinXP, Vista, Win7 |
|---|---|
| Ab Delphi-Version | Delphi 1 |
| Letzte Änderung | 28.09.2010 |
Dieser Artikel zeigt, wie Sie Ordner im Netzwerk freigeben. Da es für Windows-Versionen, die der NT-Familie (NT/2k/XP) angehören, eine andere API-Funktion gibt, als für die restlichen Windows-Versionen, muss beim Aufruf unterschieden werden. Dies erledigt die untenstehende Funktion "ShareDir", die je nach Betriebssystem automatisch die richtige Funktion aufruft: ShareDirA enthält die Implementierung für die 9x/Me-Serie und ShareDirW ist für die NT-Linie zuständig. Sie unterscheiden sich lediglich bei den Recordtypen, die einmal AnsiStrings (ShareDirA) und einmal WideStrings (ShareDirW) enthalten.Sie müssen lediglich die Funktion ShareDir aufrufen, die 4 Parameter erwartet und bei Erfolg True zurückgibt. Bei dem ersten Parameter handelt es sich um das Verzeichnis (ohne abschließenden Backslash), bei dem zweiten um den Ressourcennamen, der angezeigt werden soll. Dem dritten Parameter wird ein mögliches Passwort übergeben. Über den vierten Parameter können Sie steuern, ob andere Benutzer Schreibzugriff (False) oder nur Lesezugriff (True) haben sollen.
const
SType_DiskTree = 0;
Access_Read = 1;
Access_All = 127;
Nerr_Success = 0;
type
TShareInfo2ExW = record
shi2_NetName: PWideChar;
shi2_Type: Longword;
shi2_Remark: PWideChar;
shi2_Permissions: Longword;
shi2_Max_Uses: Longword;
shi2_Current_Uses: Longword;
shi2_Path: PWideChar;
shi2_Passwd: PWideChar;
end;
TShareInfo2ExA= record
shi2_NetName: PAnsiChar;
shi2_Type: Longword;
shi2_Remark: PAnsiChar;
shi2_Permissions: Longword;
shi2_Max_Uses: Longword;
shi2_Current_Uses: Longword;
shi2_Path: PAnsiChar;
shi2_Passwd: PAnsiChar;
end;
type
TNetShareAddFunc = function (servername: PChar; level: Longword;
const buf: Pointer;
parm_err: PLongWord): LongWord; stdcall;
function ShareDirA(const ADir, AName, APassword: string; ReadOnly: Boolean): Boolean;
var
Info: TShareInfo2ExA;
Err: Longword;
Lib: THandle;
NetShareAddFunc: TNetShareAddFunc;
begin
Result:=False;
Lib:= LoadLibrary('Svrapi.dll');
if Lib <> 0 then
begin
try
@NetShareAddFunc:= GetProcAddress(Lib,'NetShareAdd');
if @NetShareAddFunc <> nil then
begin
FillChar(Info, SizeOf(Info), 0);
Info.shi2_netname := PAnsiChar(AName);
Info.shi2_type := SType_DiskTree;
Info.shi2_remark := nil;
if ReadOnly then
Info.shi2_permissions := Access_Read
else
Info.shi2_permissions := Access_All;
Info.shi2_max_uses := LongWord(-1);
Info.shi2_current_uses := 0;
Info.shi2_path := PAnsiChar(ADir);
Info.shi2_passwd := PAnsiChar(APassword);
Result := NetShareAddFunc(nil, 2, @Info, @Err) = NERR_SUCCESS;
end
else
RaiseLastOSError;
finally
FreeLibrary(Lib);
end;
end;
end;
function ShareDirW(const ADir, AName, APassword: WideString; ReadOnly: Boolean): Boolean;
var
Info: TShareInfo2ExW;
Err: Longword;
Lib: THandle;
NetShareAddFunc: TNetShareAddFunc;
begin
Result:=False;
Lib:= LoadLibrary('Netapi32.dll');
if Lib <> 0 then
begin
try
@NetShareAddFunc:= GetProcAddress(Lib,'NetShareAdd');
if @NetShareAddFunc <> nil then
begin
FillChar(Info, SizeOf(Info), 0);
Info.shi2_netname := PWideChar(AName);
Info.shi2_type := SType_DiskTree;
Info.shi2_remark := nil;
if ReadOnly then
Info.shi2_permissions := Access_Read
else
Info.shi2_permissions := Access_All;
Info.shi2_max_uses := LongWord(-1);
Info.shi2_current_uses := 0;
Info.shi2_path := PWideChar(ADir);
Info.shi2_passwd := PWideChar(APassword);
Result := NetShareAddFunc(nil, 2, @Info, @Err) = Nerr_Success;
end
else
RaiseLastOSError;
finally
FreeLibrary(Lib);
end;
end;
end;
function ShareDir(const ADir, AName, APassword: WideString; ReadOnly: Boolean): Boolean;
begin
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
Result := ShareDirA(ADir, AName, APassword, ReadOnly)
else
Result := ShareDirW(ADir, AName, APassword, ReadOnly);
end;
RaiseLastOSError ist erst ab Delphi 6 verfügbar. Programmierer, die mit älteren Versionen arbeiten, müssen an dieser Stelle RaiseLastWin32Error verwenden.Ein Aufruf könnte so aussehen:
procedure TForm1.FormCreate(Sender: TObject);
begin
if ShareDir('C:freigabe', 'Freigabe-Ordner', '', True) then
Showmessage('Freigabe erfolgt');
end;