WindowsNT/95/98 共通して利用できるサンプルです。95/98とNTでは手順が異
なりますが本サンプルの中でカバーしています。サンプルでは情報をテキスト
化していますが、必要に応じてインターフェースを替えてください。

【コード】

interface

  // 空文字指定では、自分のマシンの情報を返却します。
  function GetRemoteOSInfo(ComputerName: string): string;

implementation

type
  // Bit-mapped values for svX_type fields. X = 1, 2 or 3.
  TServerType = (
    stLanManWorkStation, stLanManServer, stSQLServerActive,
    stPrimaryDomain, stBackupDomain, stTimeSourceActive,
    stAppleFileProtocol, stNovell, stDomainMember, stPrinterServer,
    stDialInActive, stXenixOrUnix, stWindowsNT, stWinForWorkGroups,
    stMFPNServer, stWindowsNTServer, stPotentialBrowser,
    stBackupBrowser, stMasterBrowser, stDomainMaster,
    stOSFServer, stVMSServer, stWindows9x, stDFS, stReserved1,
    stReserved2, stReserved3, stReserved4, stReserved5,
    stAlternateXPort, stLocalListOnly, stDomainEnum
  );
  TServerTypes = set of TServerType;

  // netapi32.dll(WinNT)用
  TNetServerGetInfoW = function (
    const ServerName: PWideChar;
    const Level: DWORD;
    var bufptr: PByte
  ): DWORD; stdcall;

  PServerInfo101 = ^TServerInfo101;
  TServerInfo101 = packed record
    PlatformID: DWORD;
    Name: PWideChar;
    VersionMajor: DWORD;
    VersionMinor: DWORD;
    ServerTypes: TServerTypes;
    Comment: PWideChar;
  end;

  // svrApi.dll(Win95)用
  TNetServerGetInfoA = function (
    const ServerName: PChar;
    const Level: SmallInt;
    Buffer: Pointer;
    BufferSize: WORD;
    var TotalAvail: WORD
  ): DWORD; stdcall;

  PServerInfo1 = ^TServerInfo1;
  TServerInfo1 = packed record
    Name: array[0..15] of Char;
    VersionMajor: Byte;
    VersionMinor: Byte;
    ServerTypes: TServerTypes;
    Comment: PChar;
  end;

const
  SV_PLATFORM_ID_OS2 = 400;
  SV_PLATFORM_ID_NT  = 500;

  ServerTypeDescription: array[TServerType] of string = (
    'ワークステーション', 'サーバー', 'SQLサーバ動作中',
    'プライマリドメイン', 'バックアップドメイン',
    'タイムソースサービス実行中', 'Appleﾌｧｲﾙﾌﾟﾛﾄｺﾙ',
    'Novell', 'ドメインメンバ', '印刷キューを共有',
    'ダイアルインサービス実行中', 'Xenix/Unix', 'Windows NT',
    'Windows for Workgroups実行中', 'MFPNサーバ', 'Windows NT Non-DC',
    'ブラウザ サービス実行可能',
    'ブラウザ サービスをバックアップとして実行中',
    'マスタ ブラウザ サービスを実行中',
    'ドメイン マスタ ブラウザを実行中', 'OSF', 'VMS',
    'Windows 95以降', '',
    '', '', '', '', '',  // 予約
    '', '', 'ドメイン アナウンスメント'
  );


function GetRemoteOSInfo(ComputerName: string): string;
var
  VI: TOSVersionInfo;
  hLanManLib: THandle;
  NetServerGetInfo95: TNetServerGetInfoA;
  NetServerGetInfoNT: TNetServerGetInfoW;
  BufA: PServerInfo1;
  BufW: PServerInfo101;
  TotalEntries: WORD;
  Ident: TServerType;
  rinf: DWORD;
  WS: WideString;
  Dumy: TServerInfo1;
begin
  VI.dwOSVersionInfoSize := Sizeof(VI);
  if GetVersionEx(VI) then
  begin
    case VI.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        hLanManLib := LoadLibrary('svrapi.dll');
        try
          if hLanManLib <> 0 then
          begin
            @NetServerGetInfo95 := GetProcAddress(hLanManLib,
                                    'NetServerGetInfo');
            if @NetServerGetInfo95 <> nil then
            begin
              // 必要なサイズを取得
              rinf := NetServerGetInfo95(
                PChar(ComputerName),
                1,
                @Dumy,
                Sizeof(Dumy),
                TotalEntries
              );
              // データサイズ不足の復帰値か？
              if (rinf = 234) or (rinf = 0) then
              begin
                GetMem(BufA, TotalEntries);
                try
                  FillChar(BufA^, TotalEntries, 0);
                  rinf := NetServerGetInfo95(
                    PChar(ComputerName),
                    1,
                    BufA,
                    TotalEntries,
                    TotalEntries
                  );

                  if rinf <> 0 then
                  begin
                    raise Exception.Create('失敗！！ ('+
                      IntToStr(rinf)+')='+SysErrorMessage(rinf));
                  end;

                  Result := '';
                  Result := Result + 'ホスト名：'+ #9 +
                    StrPas(BufA^.Name) + #13#10;
                  if StrPas(BufA^.Comment) <> '' then
                    Result := Result + 'コメント：'+ #9 +
                      StrPas(BufA^.Comment) + #13#10;
                  Result := Result + '種別：'+#13#10;
                  for Ident := stSQLServerActive to stDFS do
                  begin
                    if Ident in BufA^.ServerTypes then
                      Result := Result + #9 + '[' +
                        ServerTypeDescription[Ident] + ']'+#13#10;
                  end;
                finally
                  FreeMem(BufA);
                end;
              end else begin
                raise Exception.Create('失敗！！ ('+
                  IntToStr(rinf)+')='+SysErrorMessage(rinf));
              end;
            end else begin
              raise Exception.Create('NetServerGetInfo が DLL に' +
                '見つからない！');
            end;
          end else begin
            raise Exception.Create('svrapi.dll ロード失敗');
          end;
        finally
          FreeLibrary(hLanManLib);
        end;
      end;
    VER_PLATFORM_WIN32_NT:
      begin
        hLanManLib := LoadLibrary('netapi32.dll');
        try
          if hLanManLib <> 0 then
          begin
            @NetServerGetInfoNT := GetProcAddress(hLanManLib,
              'NetServerGetInfo');
            if (@NetServerGetInfoNT <> nil) then
            begin
              WS := ComputerName;
              rinf := NetServerGetInfoNT(
                PWideChar(WS),
                101,
                PByte(BufW)
              );

              if (rinf <> 0) or (BufW = nil) then
              begin
                raise Exception.Create('失敗！！ (' +IntToStr(rinf)+
                  ')='+ SysErrorMessage(rinf));
              end;

              Result := '';
              Result := Result + 'ホスト名：' + #9 +
                WideCharToString(BufW^.Name) + #13#10;
              if WideCharToString(BufW^.Comment) <> '' then
                Result := Result + 'コメント：' + #9 +
                  WideCharToString(BufW^.Comment) + #13#10;
              Result := Result + '種別：'+#13#10;
              for Ident := stSQLServerActive to stDFS do
              begin
                if Ident in BufW^.ServerTypes then
                  Result := Result + #9 + '[' +
                    ServerTypeDescription[Ident] + ']'+#13#10;
              end;
            end else begin
              raise Exception.Create('NetServerGetInfo が ' +
                'DLL に見つからない！');
            end;
          end else begin
            raise Exception.Create('netapi32.dll ロード失敗');
          end;
        finally
          FreeLibrary(hLanManLib);
        end;
      end;
    else
      raise Exception.Create('このプラットフォームでは動作不可');
    end;
  end;
end;


【使用例】

  ShowMessage(GetRemoteOSInfo('\\RemoteCom'));


【参考】
Win32APIヘルプやVisualC ver 5.0 のヘッダファイル



▲●    2000/04/28 02:48 JDX06162(とんちんかんちんかとちん)
 ■     Inprise Delphi ... The Great Development Kit
uses D2Desktop, D3CSS, D4CSS, D5ENT;

Original document by かとちん        氏 ID:(JDX06162)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。