局域網內共用文件 |
尚未結案
|
windlian
一般會員 發表:3 回覆:4 積分:1 註冊:2004-05-07 發送簡訊給我 |
|
wameng
版主 發表:31 回覆:1336 積分:1188 註冊:2004-09-16 發送簡訊給我 |
unit SharedResource; { Sharing 9x/NT v3.1 Encapsulation of the NetShare functions for win9x & NT. By Jerry Ryle. I do NOT own a copy of Windows NT, so developing this component for that platform involved grueling debug sessions in labs on campus. Therefore, this component is obviously less than perfect; however, I feel it is a good start & a great learning tool. This is free stuff, but I'll take donations ;) Because of the comprehensive help file, I'm not going to comment this code; however, I'd be happy to answer questions or take suggestions by email. I have tested this component thoroughly, but I will accept no responsibility if they harm you, your computer, or your pets. Read the help file for more info. email me if you make it better -- gryle@calpoly.edu } interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ShareConst; {ShareConst.pas holds constants used by this component.} type TResType = (RTFolder, RTPrinter, RTDevice, RTIPC); TAccessType = (ATReadOnly, ATFull, ATDepends); TErrorEvent = Procedure(ErrorCode : Integer; ErrorString : String) of object; TNTAccessType = (NT_Read, NT_Write, NT_Create, NT_Execute, NT_Delete, NT_Attrib, NT_Permissions, NT_All); TNTAccessOptions = set of TNTAccessType; TSharedResource = class(TComponent) private _AccessType : Word; _Comment : String; _CurrentConnections : Integer; _MaxConnections : Integer; _NTAccessPermissions : TNTAccessOptions; _NTPermissions : Integer; _PersistShare : Boolean; _ReadOnlyPassword : String; _ReadWritePassword : String; _ResourcePath : String; _ResourceType : Byte; _ServerName : String; _ShareName : String; _SystemShare : Boolean; ErrorEvent : TErrorEvent; DLLHandle : THandle; IsNT : Boolean; {Are we in Win9x, or NT? Set by constructor.} NTNetShareAdd : function(ServerName : PChar; ShareLevel : Integer; Buffer : Pointer; Error : PLongword) : Integer; StdCall; NTNetShareDel : function(ServerName : PChar; NetName : PChar; Reserved : Integer) : Integer; StdCall; NTNetShareGetInfo : function(ServerName : PChar; NetName : PChar; ShareLevel : SmallInt; Buffer : Pointer) : Integer; StdCall; NetShareAdd : function(ServerName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word) : Integer; StdCall; NetShareDel : function(ServerName : PChar; NetName : PChar; Reserved : Word) : Integer; StdCall; NetShareGetInfo : function(ServerName : PChar; NetName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word; Var Used : Word) : Integer; StdCall; NTNetApiBufferFree : function(Buffer : Pointer) : Integer; StdCall; function GetAccessType : TAccessType; function GetResourceType : TResType; procedure SetAccessType(ToWhat : TAccessType); procedure SetComment(ToWhat : String); procedure SetNTAccessPermissions(ToWhat : TNTAccessOptions); procedure SetReadOnlyPassword(ToWhat : String); procedure SetReadWritePassword(ToWhat : String); procedure SetResourceType(ToWhat : TResType); procedure SetResPath(ToWhat : String); procedure SetServerName(ToWhat : String); procedure SetShareName(ToWhat : String); protected { Protected declarations } public constructor Create(Owner : TComponent); override; destructor Destroy; override; function IsShared : Boolean; function LoadShareInfo(ServerName : String; NetName : String) : Integer; function Share : Integer; function Unshare : Integer; function Update : Integer; published property AccessType : TAccessType read GetAccessType write SetAccessType default ATReadOnly; property Comment : String read _Comment write SetComment; property CurrentConnections : Integer read _CurrentConnections; property MaxConnections : Integer read _MaxConnections write _MaxConnections; property NTAccessPermissions : TNTAccessOptions read _NTAccessPermissions write SetNTAccessPermissions; property PersistShare : Boolean read _PersistShare write _PersistShare default false; property ReadOnlyPassword : String read _ReadOnlyPassword write SetReadOnlyPassword; property ReadWritePassword : String read _ReadWritePassword write SetReadWritePassword; property ResourcePath : String read _ResourcePath write SetResPath; property ResourceType : TResType read GetResourceType write SetResourceType default RTFolder; property ServerName : String read _ServerName write SetServerName; property ShareName : String read _ShareName write SetShareName; property SystemShare : Boolean read _SystemShare write _SystemShare default false; property OnError : TErrorEvent read ErrorEvent write ErrorEvent; end; procedure Register; implementation constructor TSharedResource.Create(Owner : TComponent); var verInfo : _OSVERSIONINFOA; begin inherited; {Initialize Stuff!} DLLHandle := 0; IsNT := False; _AccessType := SHI50F_RDONLY; _Comment := ''; _CurrentConnections := 0; _MaxConnections := -1; _NTAccessPermissions := [NT_Read]; _NTPermissions := ACCESS_READ; _PersistShare := True; _ReadOnlyPassword := ''; _ReadWritePassword := ''; _ResourcePath := ''; _ResourceType := STYPE_DISKTREE; _ServerName := ''; _ShareName := ''; _SystemShare := False; {Make sure we only load the libaries on runtime.} {Here we dynamically load the networking functions we need. The Library handle will be freed in the destructor.} if not(csDesigning in ComponentState) then begin verInfo.dwOSVersionInfoSize := sizeOf(_OSVERSIONINFOA); {See if we're running 9x or NT} GetVersionEx(verInfo); If (verInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then IsNT := True; If IsNT then begin DLLHandle := LoadLibrary(PChar('NETAPI32.DLL')); {Try Loading the WinNT library} If (DLLHandle > 0) then begin {Aaugh! NT takes different paramters than 9x! :) } @NTNetShareAdd := GetProcAddress(DLLHandle, PChar('NetShareAdd')); @NTNetShareDel := GetProcAddress(DLLHandle, PChar('NetShareDel')); @NTNetShareGetInfo := GetProcAddress(DLLHandle, PChar('NetShareGetInfo')); @NTNetApiBufferFree := GetProcAddress(DLLHandle, PChar('NetApiBufferFree')); end; end else begin DLLHandle := LoadLibrary(PChar('SVRAPI.DLL'));{Try Loading the Win9x library} If (DLLHandle > 0) then begin @NetShareAdd := GetProcAddress(DLLHandle, PChar('NetShareAdd')); @NetShareDel := GetProcAddress(DLLHandle, PChar('NetShareDel')); @NetShareGetInfo := GetProcAddress(DLLHandle, PChar('NetShareGetInfo')); end; end; end; end; destructor TSharedResource.Destroy; begin {Make sure we only unload the libaries on runtime.} if not(csDesigning in ComponentState) then If (DLLHandle > 0) then FreeLibrary(DLLHandle); inherited; end; function TSharedResource.IsShared : Boolean; var PMyNTShare : ^Share_Info2; PMyShare : ^Share_Info50; AmountUsed : Word; Err : Integer; begin Result := False; If (DLLHandle <= 0) Then begin If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded)) end else if IsNT then begin PMyNTShare := Nil; Err := NTNetShareGetInfo(PChar(WideString(_ServerName)),PChar(WideString(_ShareName)),2,@PMyNTShare); If Err = 0 Then Result := True; If (PMyNTShare <> nil) then NTNetApiBufferFree(PMyNTShare); end else begin PMyShare := AllocMem(512); Err := NetShareGetInfo(PChar(_ServerName),PChar(_ShareName),50,PMyShare,512,AmountUsed); If Err = 0 Then Result := True; FreeMem(PMyShare); end; end; function TSharedResource.LoadShareInfo(ServerName : String; NetName : String) : Integer; var PMyNTShare : ^Share_Info2; PMyShare : ^Share_Info50; AmountUsed : Word; Err : Integer; begin If (DLLHandle <= 0) Then begin If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded)); Result := NERR_DLLNotLoaded; end else if IsNT then begin PMyNTShare := Nil; Err := NTNetShareGetInfo(PChar(WideString(UpperCase(ServerName))),PChar(WideString(UpperCase(NetName))),2,@PMyNTShare); If Err = 0 Then Begin _ServerName := ServerName; _ShareName := PMyNTShare.shi2_netname; _ResourceType := PMyNTShare.shi2_type; If (PMyNTShare.shi2_permissions and ACCESS_ALL) = ACCESS_ALL then _NTAccessPermissions := _NTAccessPermissions [NT_All]; If (PMyNTShare.shi2_permissions and ACCESS_READ) = ACCESS_READ then _NTAccessPermissions := _NTAccessPermissions [NT_Read]; If (PMyNTShare.shi2_permissions and ACCESS_WRITE) = ACCESS_WRITE then _NTAccessPermissions := _NTAccessPermissions [NT_Write]; If (PMyNTShare.shi2_permissions and ACCESS_CREATE) = ACCESS_CREATE then _NTAccessPermissions := _NTAccessPermissions [NT_Create]; If (PMyNTShare.shi2_permissions and ACCESS_EXEC) = ACCESS_EXEC then _NTAccessPermissions := _NTAccessPermissions [NT_Execute]; If (PMyNTShare.shi2_permissions and ACCESS_DELETE) = ACCESS_DELETE then _NTAccessPermissions := _NTAccessPermissions [NT_Delete]; If (PMyNTShare.shi2_permissions and ACCESS_ATRIB) = ACCESS_ATRIB then _NTAccessPermissions := _NTAccessPermissions [NT_Attrib]; If (PMyNTShare.shi2_permissions and ACCESS_PERM) = ACCESS_PERM then _NTAccessPermissions := _NTAccessPermissions [NT_Permissions]; _CurrentConnections := PMyNTShare.shi2_current_uses; _MaxConnections := PMyNTShare.shi2_max_uses; _Comment := PMyNTShare.shi2_remark; _ResourcePath := PMyNTShare.shi2_path; _ReadOnlyPassword := PMyNTShare.shi2_passwd; _ReadWritePassword := PMyNTShare.shi2_passwd; End else If Assigned(OnError) then OnError(Err,GetNetErrorString(Err)); If (PMyNTShare <> nil) then NTNetApiBufferFree(PMyNTShare); Result := Err; end else begin PMyShare := AllocMem(512); Err := NetShareGetInfo(PChar(UpperCase(ServerName)),PChar(UpperCase(NetName)),50,PMyShare,512,AmountUsed); If Err = 0 Then Begin _ServerName := ServerName; _ShareName := PMyShare.shi50_netname; _ResourceType := PMyShare.shi50_type; If (PMyShare.shi50_flags and SHI50F_DEPENDSON) = SHI50F_DEPENDSON then _AccessType := SHI50F_DEPENDSON Else If (PMyShare.shi50_flags and SHI50F_RDONLY) = SHI50F_RDONLY then _AccessType := SHI50F_RDONLY Else If (PMyShare.shi50_flags and SHI50F_FULL) = SHI50F_FULL then _AccessType := SHI50F_FULL; _PersistShare := ((PMyShare.shi50_flags and SHI50F_PERSIST) = SHI50F_PERSIST); _SystemShare := ((PMyShare.shi50_flags and SHI50F_SYSTEM) = SHI50F_SYSTEM); _Comment := PMyShare.shi50_remark; _ResourcePath := PMyShare.shi50_path; _ReadOnlyPassword := PMyShare.shi50_ro_password; _ReadWritePassword := PMyShare.shi50_rw_password; End else If Assigned(OnError) then OnError(Err,GetNetErrorString(Err)); FreeMem(PMyShare); Result := Err; end; end; function TSharedResource.Share : Integer; var MyShare : Share_Info50; PMyShare : ^Share_Info50; MyNTShare : Share_Info2; PMyNTShare : ^Share_Info2; Err : Integer; ErrNum : Integer; MyFlags : Word; MyName, MyComment, MyPath, MyPW : WideString; begin Err := NERR_Success; If (DLLHandle <= 0) Then begin If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded)) end else if IsNT then begin MYName := _ShareName; MYComment := _Comment; MyPath := _ResourcePath; MyPW := _ReadOnlyPassword; MyNTShare.shi2_netname := PWideChar(MYName); MyNTShare.shi2_type := _ResourceType; MyNTShare.shi2_remark := PWideChar(MYComment); MyNTShare.shi2_permissions := _NTPermissions; MyNTShare.shi2_max_uses := _MaxConnections; MyNTShare.shi2_current_uses := 0; MyNTShare.shi2_path := PWideChar(MyPath); MyNTShare.shi2_passwd := PWideChar(MyPW); PMyNTShare := @MyNTShare; Err := NTNetShareAdd(PChar(WideString(_ServerName)),2,PMyNTShare,@ErrNum); If (Err <> NERR_Success) then If Assigned(OnError) then OnError(Err,GetNetErrorString(Err)); end else begin strLcopy(MyShare.shi50_netname,PChar(_ShareName),13); MyShare.shi50_type := _ResourceType; MyFlags := 0; If _PersistShare then MyFlags := MyFlags or SHI50F_PERSIST; If _SystemShare then MyFlags := MyFlags or SHI50F_SYSTEM; MyFlags := MyFlags or _AccessType; MyShare.shi50_flags := MyFlags; MyShare.shi50_remark := PChar(_Comment); MyShare.shi50_path := PChar(_ResourcePath); strLcopy(MyShare.shi50_rw_password,PChar(_ReadWritePassword),9); strLcopy(MyShare.shi50_ro_password,PChar(_ReadOnlyPassword),9); PMyShare := @MyShare; Err := NetShareAdd(PChar(_ServerName),50,PMyShare,SizeOf(MyShare)); If (Err <> NERR_Success) then If Assigned(OnError) then OnError(Err,GetNetErrorString(Err)); end; result := Err; end; function TSharedResource.Unshare : Integer; var Err : Integer; begin If IsNT Then Err := NTNetShareDel(PChar(WideString(_ServerName)),PChar(WideString(_ShareName)),0) Else Err := NetShareDel(PChar(_ServerName),PChar(_ShareName),0); If (Err <> 0 ) then If Assigned(OnError) then OnError(Err,GetNetErrorString(Err)); Result := Err; end; function TSharedResource.Update : Integer; var Err : Integer; begin Err := NERR_Success; If IsShared Then Begin Err := UnShare; If Err = NERR_Success Then Err := Share; End Else Err := NERR_NetNameNotFound; If (Err <> NERR_Success) then If Assigned(OnError) then OnError(Err,GetNetErrorString(Err)); Result := Err; end; function TSharedResource.GetAccessType : TAccessType; begin if _AccessType = SHI50F_RDONLY then Result := ATReadOnly else if _AccessType = SHI50F_FULL then Result := ATFull else Result := ATDepends; end; function TSharedResource.GetResourceType : TResType; begin if _ResourceType = STYPE_PRINTQ then result := RTPrinter else result := RTFolder; end; procedure TSharedResource.SetAccessType(ToWhat : TAccessType); begin if ToWhat = ATReadOnly then _AccessType := SHI50F_RDONLY else if ToWhat = ATFull then _AccessType := SHI50F_FULL else _AccessType := SHI50F_DEPENDSON; end; procedure TSharedResource.SetComment(ToWhat : String); begin If Length(ToWhat) > 255 then ToWhat := Copy(ToWhat,1,255); _Comment := ToWhat; end; procedure TSharedResource.SetNTAccessPermissions(ToWhat : TNTAccessOptions); begin _NTAccessPermissions := ToWhat; _NTPermissions := 0; If NT_Read in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_READ; If NT_Write in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_WRITE; If NT_Execute in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_EXEC; If NT_Create in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_CREATE; If NT_Delete in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_DELETE; If NT_Attrib in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_ATRIB; If NT_Permissions in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_PERM; If NT_All in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_ALL; end; procedure TSharedResource.SetReadOnlyPassword(ToWhat : String); begin if Length(ToWhat) > 9 then ToWhat := Copy(ToWhat,1,9); _ReadOnlyPassword := ToWhat; if isNT then _ReadWritePassword := ToWhat; end; procedure TSharedResource.SetReadWritePassword(ToWhat : String); begin if Length(ToWhat) > 9 then ToWhat := Copy(ToWhat,1,9); _ReadWritePassword := ToWhat; if isNT then _ReadOnlyPassword := ToWhat; end; procedure TSharedResource.SetResourceType(ToWhat : TResType); begin if ToWhat = RTPrinter then _ResourceType := STYPE_PRINTQ else if ((ToWhat = RTDevice) and isNT) then _ResourceType := STYPE_DEVICE else if ((ToWhat = RTIPC) and isNT) then _ResourceType := STYPE_IPC else _ResourceType := STYPE_DISKTREE; end; procedure TSharedResource.SetResPath(ToWhat : String); begin _ResourcePath := UpperCase(ToWhat); end; procedure TSharedResource.SetServerName(ToWhat : String); begin if (isShared and not(csDesigning in ComponentState)) then begin Unshare; _ServerName := UpperCase(ToWhat); Share; end else _ServerName := UpperCase(ToWhat); end; procedure TSharedResource.SetShareName(ToWhat : String); begin if (Length(ToWhat) > 13) and Not IsNT then ToWhat := Copy(ToWhat,1,13); if (Length(ToWhat) > 81) then ToWhat := Copy(ToWhat,1,81); if (isShared and not(csDesigning in ComponentState)) then begin Unshare; _ShareName := UpperCase(ToWhat); Share; end else _ShareName := UpperCase(ToWhat); end; procedure Register; begin RegisterComponents('ThrdParty', [TSharedResource]); end; end.這個元件可以做到。 發表人 - wameng 於 2004/12/02 09:44:43 |
windlian
一般會員 發表:3 回覆:4 積分:1 註冊:2004-05-07 發送簡訊給我 |
|
wameng
版主 發表:31 回覆:1336 積分:1188 註冊:2004-09-16 發送簡訊給我 |
|
windlian
一般會員 發表:3 回覆:4 積分:1 註冊:2004-05-07 發送簡訊給我 |
|
wameng
版主 發表:31 回覆:1336 積分:1188 註冊:2004-09-16 發送簡訊給我 |
|
windlian
一般會員 發表:3 回覆:4 積分:1 註冊:2004-05-07 發送簡訊給我 |
|
Ktop_Robot
站務副站長 發表:0 回覆:3511 積分:0 註冊:2007-04-17 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |