Subversion Repositories userdetect2

unit todo_more_identifications;

interface

function IsConnected: boolean;

function GetHostname: string;

function GetComputerName: String;

function GetUserName: String;

function GetSystemWinDir: string;

function GetSystemDrive: AnsiChar;

function GetOSVersion: string;

function GetRegisteredOrganisation: string;

function GetRegisteredOwner: string;

function LaufwerkBereit(root: string): boolean;

function GetMyDocuments: string;

function GetLocalAppData: string;

function GetWindowsDirectory: string;

// function GetWifiSSID: string;

function GetTempDirectory: String;

implementation

uses

  Windows, SysUtils, Registry, wininet, shlobj;

type

  EAPICallError = Exception;

function IsConnected: boolean;

{$IF defined(ANDROID)}

begin

  result := IsConnectedAndroid;

end;

{$ELSEIF defined(MACOS)}

//var

  //IPW: TIdHTTP;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := false;  // TODO: im zweifelsfall lieber true?

  // head verzögert den Programmfluss um 1-2 Sekunden...

  // Ip-Watch würde auch eine LAN-Adresse zeigen

  //TIdHTTP.Head('http://registration.rinntech.com');

  //response.code=200 -> true

end;

{$ELSEIF defined(MSWINDOWS)}

var

  origin: Cardinal;

begin

  result := InternetGetConnectedState(@origin, 0);

end;

{$ELSE}

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := false;

end;

{$IFEND}

var CacheHostname: string;

{$IFDEF MSWindows}

function GetHostname: string;

var

  reg: TRegistry;

begin

  if CacheHostname <> '' then

  begin

    result := CacheHostname;

    Exit;

  end;

  result := '';

  reg := TRegistry.Create;

  try

    reg.RootKey := HKEY_LOCAL_MACHINE;

    if reg.OpenKeyReadOnly

      ('\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters') then

    begin

      result := reg.ReadString('Hostname');

      reg.CloseKey;

    end;

  finally

    reg.Free;

  end;

  CacheHostname := result;

end;

{$ELSE}

function GetHostname: string;

{$IFDEF MACOS}

var

  buff: array [0 .. 255] of AnsiChar;

{$ENDIF}

begin

  if CacheHostname <> '' then

  begin

    result := CacheHostname;

    Exit;

  end;

  {$IFDEF MACOS}

  Posix.Unistd.gethostname(buff,sizeof(buff));

  SetString(result, buff, AnsiStrings.strlen(buff));

  CacheHostname := result;

  {$ELSE}

    {$IFDEF ANDROID}

    result := '';

    {$ELSE}

    {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

    {$ENDIF}

  {$ENDIF}

end;

{$ENDIF}

{$IFDEF MSWindows}

function GetComputerName: String;

var

  buffer: array [0 .. MAX_PATH] of Char;

  Size: dWord;

begin

  Size := SizeOf(buffer);

  Windows.GetComputerName(buffer, Size);

  SetString(result, buffer, lstrlen(buffer));

end;

{$ELSE}

function GetComputerName: String;

{$IFDEF MACOS}

var

  Pool: NSAutoreleasePool;

  h : NSHost;

{$ENDIF}

begin

  {$IFDEF MACOS}

  NSDefaultRunLoopMode;

  Pool := TNSAutoreleasePool.Create;

    try

    h := TNSHost.Wrap(TNSHost.OCClass.currentHost);

    result := Format('%s',[h.localizedName.UTF8String]);

  finally

    Pool.drain;

  end;

  {$ELSE}

    {$IFDEF ANDROID}

    //TODO: anderer/richtiger name ... AccountManager for email adress, Telephony mngr etc.

    result := JStringToString(TJBuild.JavaClass.SERIAL);

    {$ELSE}

    {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

    result := '';

    {$ENDIF}

  {$ENDIF}

end;

{$ENDIF}

{$IFDEF MACOS}

function NSUserName: Pointer; cdecl; external '/System/Library/Frameworks/Foundation.framework/Foundation' name _PU +'NSUserName';

function NSFullUserName: Pointer; cdecl; external '/System/Library/Frameworks/Foundation.framework/Foundation' name _PU + 'NSFullUserName';

{$ENDIF}

{$IFDEF MSWindows}

function GetUserName: String;

var

  buffer: array [0 .. MAX_PATH] of Char;

  Size: dWord;

begin

  Size := SizeOf(buffer);

  if Windows.GetUserName(Buffer, Size) then

  begin

    // SetString(result, buffer, lstrlen(buffer));

    Result := StrPas(Buffer);

  end

  else

  begin

    Result := '';

  end;

end;

{$ELSE}

function GetUserName: String;

begin

  {$IFDEF MACOS}

  result := Format('%s',[TNSString.Wrap(NSUserName).UTF8String]);

  {$ELSE}

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

  {$ENDIF}

end;

{$ENDIF}

{$IFDEF MSWindows}

function GetSystemWinDir: string;

var

  h: HModule;

  {$IFDEF UNICODE}

  f: function(lpBuffer: LPWSTR; uSize: UINT): UINT; stdcall;

  {$ELSE}

  f: function(lpBuffer: LPSTR; uSize: UINT): UINT; stdcall;

  {$ENDIF}

  res: string;

  cnt: UINT;

begin

  h := LoadLibrary(kernel32);

  if h = 0 then RaiseLastOSError;

  {$IFDEF UNICODE}

  @f := GetProcAddress(h, 'GetSystemWindowsDirectoryW');

  {$ELSE}

  @f := GetProcAddress(h, 'GetSystemWindowsDirectoryA');

  {$ENDIF}

  SetLength(res, MAX_PATH);

  if @f = nil then  // Assigned?

  begin

    // We are probably on Win9x where GetSystemWindowsDirectory* does not exist.

    cnt := Windows.GetWindowsDirectory(PChar(res), MAX_PATH);

  end

  else

  begin

    // We are on a modern system where GetSystemWindowsDirectory* does exist.

    // http://objectmix.com/delphi/402836-getting-hard-drive-letter-windows-runs.html

    // Im Gegensatz zu GetWindowsDirectory zeigt GetSystemWindowsDirectory bei

    // Terminalservern das System-Windows-Verzeichnis und nicht das "private"

    // Windows-Verzeichnis des Users.

    cnt := f(PChar(res), MAX_PATH);

  end;

  if cnt <= 0 then RaiseLastOSError;

  result := res;

end;

{$ELSE}

function GetSystemWinDir: string;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

end;

{$ENDIF}

function GetSystemDrive: AnsiChar;

var

  res: string;

begin

  res := ExtractFileDrive(GetSystemWinDir);

  Assert(Length(res) >= 1);

  result := AnsiChar(res[1]);

end;

function GetOSVersion: string;

{$IF Declared(TOSVersion)}

begin

  result := TOSVersion.ToString;

{$ELSE}

var

  VersionInfo: TOSVersionInfo;

begin

  VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);

  GetVersionEx(VersionInfo);

  result := IntToStr(VersionInfo.dwPlatformId) + '-' +

    IntToStr(VersionInfo.dwMajorVersion) + '.' +

    IntToStr(VersionInfo.dwMinorVersion) + '-' +

    IntToStr(VersionInfo.dwBuildNumber)

{$IFEND}

end;

{$IFDEF MSWindows}

function GetRegisteredOrganisation: string;

var

  reg: TRegistry;

  k: string;

  VersionInfo: TOSVersionInfo;

begin

  result := '';

  reg := TRegistry.Create;

  try

    reg.rootkey := HKEY_LOCAL_MACHINE;

    VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);

    GetVersionEx(VersionInfo);

    if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then

    begin

      k := '\Software\Microsoft\Windows NT\CurrentVersion';

    end

    else

    begin

      k := '\Software\Microsoft\Windows\CurrentVersion';

    end;

    if reg.OpenKeyReadOnly(k) then

    begin

      result := reg.ReadString('RegisteredOrganization');

      reg.CloseKey;

    end;

  finally

    reg.Free;

  end;

end;

{$ELSE}

function GetRegisteredOrganisation: string;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

end;

{$ENDIF}

{$IFDEF MSWindows}

function GetRegisteredOwner: string;

var

  reg: TRegistry;

  k: string;

  VersionInfo: TOSVersionInfo;

begin

  result := '';

  reg := TRegistry.Create;

  try

    reg.rootkey := HKEY_LOCAL_MACHINE;

    VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);

    GetVersionEx(VersionInfo);

    if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then

    begin

      k := '\Software\Microsoft\Windows NT\CurrentVersion';

    end

    else

    begin

      k := '\Software\Microsoft\Windows\CurrentVersion';

    end;

    if reg.OpenKeyReadOnly(k) then

    begin

      result := reg.ReadString('RegisteredOwner');

      reg.CloseKey;

    end;

  finally

    reg.Free;

  end;

end;

{$ELSE}

function GetRegisteredOwner: string;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

end;

{$ENDIF}

{$IFDEF MSWindows}

function LaufwerkBereit(root: string): boolean;

var

  Oem: cardinal;

  Dw1, Dw2: DWORD;

begin

  // http://www.delphi-treff.de/tipps/system/hardware/feststellen-ob-ein-laufwerk-bereit-ist/

  Oem := SetErrorMode(SEM_FAILCRITICALERRORS);

  result := GetVolumeInformation(PCHAR(Root), nil, 0, nil, Dw1, Dw2, nil, 0);

  SetErrorMode(Oem) ;

end;

{$ELSE}

function LaufwerkBereit(root: string): boolean;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := false;

end;

{$ENDIF}

{$IFDEF MSWindows}

function GetMyDocuments: string;

var

  r: Bool;

  path: array[0..Max_Path] of Char;

begin

  // TODO: Stattdessen ShGetFolderPath verwenden?

  r := ShGetSpecialFolderPath(0, path, CSIDL_Personal, False);

  if not r then

    raise EAPICallError.Create('Could not find MyDocuments folder location.');

  Result := Path;

end;

{$ELSE}

function GetMyDocuments: string;

begin

  result := TPath.GetDocumentsPath;

end;

{$ENDIF}

{$IF not Defined(CSIDL_LOCAL_APPDATA)}

const

  CSIDL_LOCAL_APPDATA = $001c;

{$IFEND}

{$IFDEF MSWindows}

function GetLocalAppData: string;

var

  r: Bool;

  path: array[0..Max_Path] of Char;

begin

  // TODO: Stattdessen ShGetFolderPath verwenden?

  r := ShGetSpecialFolderPath(0, path, CSIDL_LOCAL_APPDATA, False);

  if not r then

    raise EAPICallError.Create('Could not find LocalAppData folder location.');

  Result := Path;

end;

{$ELSE}

function GetLocalAppData: string;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

end;

{$ENDIF}

{$IFDEF MSWindows}

function GetWindowsDirectory: string;

var

  WinDir: PChar;

begin

  WinDir := StrAlloc(MAX_PATH);

  try

    Windows.GetWindowsDirectory(WinDir, MAX_PATH);

    result := string(WinDir);

  finally

    StrDispose(WinDir);

  end;

end;

{$ELSE}

function GetWindowsDirectory: string;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

end;

{$ENDIF}

{$IFDEF MSWindows}

function GetTempDirectory: String;

var

  tempFolder: array [0 .. MAX_PATH] of Char;

begin

  GetTempPath(MAX_PATH, @tempFolder);

  result := StrPas(tempFolder);

end;

{$ELSE}

function GetTempDirectory: String;

begin

  {$MESSAGE Warn 'Nicht implementiert für dieses OS'}

  result := '';

end;

{$ENDIF}

end.