１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"ネットワークドライブの割り当て／切断"
■概要
ネットワークドライブの割り当て／切断他の簡単なサンプルです。
■コンポーネント
Form1 に Memo1, Edit1 〜 Edit4, Button1 〜 Button5 を適当に配置
して下さい。
■注意事項
・Windows98SE + Delphi5 Pro で動作確認。
・本サンプルは、ご自身の責任においてお試し下さい。 m(_"_)m
■サンプルコード
//=========================================================================
{...略...}
type
TForm1 = class(TForm)
{...略...}
private
{ Private 宣言 }
procedure ShowConnections;
public
{ Public 宣言 }
end;
{...略...}
implementation
{...略...}
{*************************************************************************
Form1 OnCreate
//***********************************************************************}
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := ''; Edit2.Text := '';
Edit3.Text := ''; Edit4.Text := '';
Memo1.Text := 'Edit1 には Remote Network 名 を入れてね.'#13#10
+ 'Edit2 には Local drive 名( F: 等 )を入れてね.'#13#10
+ 'Edit3 には User 名 を入れてね.'#13#10
+ 'Edit4 には Password を入れてね.';
Button1.Caption := 'Map';
Button2.Caption := 'Unmap';
Button3.Caption := 'ConnectionDlg';
Button4.Caption := 'DisconnectDlg';
Button5.Caption := 'Enumerate';
end;
{*************************************************************************
Button1 OnClick
・Network resource に接続する。
//***********************************************************************}
procedure TForm1.Button1Click(Sender: TObject);
var
NetRes : TNetResource;
Res : Cardinal;
Drive,
Path : array [0..255] of Char;
begin
{* NetRes を初期化 *}
FillChar( NetRes, SizeOf( NetRes ), 0 );
{* Network resource に接続 *}
with NetRes do begin
dwType := RESOURCETYPE_DISK;
lpLocalName := StrPCopy( Drive, Edit2.Text );
lpRemoteName := StrPCopy( Path, Edit1.Text );
end;{with NetRes do}
try
Res := WNetAddConnection2( NetRes, PChar( Edit4.Text ),
PChar( Edit3.Text ), 0 );
if Res = 0 then ShowMessage('接続しました.') else RaiseLastWin32Error;
finally
ShowConnections;
end;
end;
{*************************************************************************
Button2 OnClick
・既存のネットワーク接続をブレークする。
//***********************************************************************}
procedure TForm1.Button2Click(Sender: TObject);
var
Res : Cardinal;
Buff: array[0..255] of Char;
begin
if Edit2.Text <> '' then
StrPCopy( Buff, Edit2.Text )
else
StrPCopy( Buff, Edit1.Text );
try
// Res := WNetCancelConnection2( Buff, 0, True );
Res := WNetCancelConnection2( Buff, 0, False );
{* 結果表示 *}
if Res = 0 then
ShowMessage( Buff + ' は切断されました.' )
else
RaiseLastWin32Error;
finally
{* Connection 一覧を更新 *}
ShowConnections;
end;
end;
{*************************************************************************
Button3 OnClick
・ネットワークドライブの割り当てダイアログを表示する。
//***********************************************************************}
procedure TForm1.Button3Click(Sender: TObject);
begin
WNetConnectionDialog( Handle, RESOURCETYPE_DISK );
ShowConnections;
end;
{*************************************************************************
Button4 OnClick
・ネットワークドライブの切断ダイアログを表示する。
//***********************************************************************}
procedure TForm1.Button4Click(Sender: TObject);
begin
WNetDisconnectDialog( Handle, RESOURCETYPE_DISK );
ShowConnections;
end;
{*************************************************************************
Button5 OnClick
・Connection の一覧を Memo1 に表示する。
//***********************************************************************}
procedure TForm1.Button5Click(Sender: TObject);
begin
ShowConnections;
end;
{*************************************************************************
ShowConnections
・Connection の一覧を Memo1 に表示する。
//***********************************************************************}
procedure TForm1.ShowConnections;
type
TResType = ( rtConnected, rtRemembered, rtGlobalNet );
TAddNetResFunc = function( const pNetRes: PNetResource ): String;
const
cResType: array[TResType] of DWORD = ( RESOURCE_CONNECTED,
RESOURCE_REMEMBERED,
RESOURCE_GLOBALNET );
cTitle : array[TResType] of String
= ( 'All currently connected resources:',
'All remembered connections:',
'All resources on the network:' );
cError : array[TResType] of String
= ( ' --> No active connections',
' --> No remembered connections',
' --> No resources' );
var
AddNetResFunc: array[TResType] of TAddNetResFunc;
EnumHandle,
Count,
Size, SizeNR,
Res : Cardinal;
i : Integer;
iRT : TResType;
Buff : array[0..255] of Char;
BuffSize : Cardinal;
pNetRes : PNetResource;
pCurrNetRes : PChar;
function ConnectedNetRes( const pNetRes: PNetResource ): String;
begin
with pNetRes^ do begin
if lpLocalName = nil then
Result := '(none)' + #9 + String( lpRemoteName )
else
Result := String( lpLocalName ) + #9 + String( lpRemoteName );
end;{with NetRes do}
end;
function RememberedNetRes( const pNetRes: PNetResource ): String;
begin
with pNetRes^ do begin
Res := WNetGetConnection( lpLocalName, Buff, BuffSize );
Result := String( lpLocalName ) + #9 + String( lpRemoteName );
end;{with NetRes do}
if Res = 0 then
Result := Result + #9 + ' ( Connected to ' + Buff + ' )'
else if Res = ERROR_CONNECTION_UNAVAIL then
Result := Result + #9 + ' ( Not connected )';
end;
begin
Memo1.Lines.Clear;
AddNetResFunc[ rtConnected ] := @ConnectedNetRes;
AddNetResFunc[ rtRemembered ] := @RememberedNetRes;
BuffSize := SizeOf( Buff );
SizeNR := SizeOf( TNetResource );
Size := ( SizeNR + BuffSize * 4 ) * 30;
pNetRes := AllocMem( Size );
try
for iRT := rtConnected to Pred( High( TResType )) do begin
Memo1.Lines.Add( cTitle[iRT] );
Res := WNetOpenEnum( cResType[iRT], RESOURCETYPE_DISK,
0, nil, EnumHandle );
if Res <> 0 then RaiseLastWin32Error;
try
Count := $FFFFFFFF;
Res := WNetEnumResource( EnumHandle, Count, pNetRes, Size );
if Res = ERROR_MORE_DATA then
begin
Size := Size + ( Size div SizeNR ) * BuffSize * 4;
ReAllocMem( pNetRes, Size );
Count := $FFFFFFFF;
Res := WNetEnumResource( EnumHandle, Count, pNetRes, Size );
end;{if Res = ERROR_MORE_DATA then}
if Res <> 0 then
case Res of
ERROR_NO_MORE_ITEMS: Memo1.Lines.Add( cError[iRT] );
else RaiseLastWin32Error;
end;{case Res of / if Res <> 0 then}
pCurrNetRes := PChar( pNetRes );
for i := 0 to Pred( Count ) do begin
Memo1.Lines.Add(
AddNetResFunc[iRT]( PNetResource( pCurrNetRes ))
);
Inc( pCurrNetRes, SizeNR );
end;{for i := 0 to Pred( Count ) do}
finally
Res := WNetCloseEnum( EnumHandle );
if Res <> 0 then RaiseLastWin32Error;
end;{try..finally..}
Memo1.Lines.Add('');
end;{for iRT := rtConnected to Pred( High( TResType )) do}
finally
FreeMem( pNetRes );
end;{try..finally..}
end;
{*************************************************************************
//***********************************************************************}
end.
//=========================================================================
00/11/22(Wed) 03:34pm Fermion [KHF03264]
- FDELPHI MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 00/11/28 -
Original document by Fermion 氏 ID:(KHF03264)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。