Subversion Repositories userdetect2

Compare Revisions

No changes between revisions

Regard whitespace Rev 67 → Rev 68

/trunk/UserDetect2/testuser/Functions.pas
0,0 → 1,103
unit Functions;
 
interface
 
function GetComputerName: string;
function GetUserName: string;
function GetCurrentUserSid: string;
function ExpandEnvironmentStrings(ATemplate: string): string;
function StrICmp(a, b: string): boolean;
function EnforceLength(s: string; len: integer; filler: char;
appendRight: boolean): string;
function GetHomeDir: string;
 
implementation
 
uses
Windows, SysUtils, Registry, SPGetSid;
 
function GetComputerName: string; // Source: Luckie@DP
var
buffer: array[0..MAX_PATH] of Char; // MAX_PATH ?
size: DWORD;
begin
size := SizeOf(buffer);
ZeroMemory(@buffer, size);
Windows.GetComputerName(buffer, size);
SetString(result, buffer, lstrlen(buffer));
end;
 
function GetUserName: string; // Source: Luckie@DP
var
buffer: array[0..MAX_PATH] of Char; // MAX_PATH ?
size: DWORD;
begin
size := SizeOf(buffer);
ZeroMemory(@buffer, size);
Windows.GetUserName(buffer, size);
SetString(result, buffer, lstrlen(buffer));
end;
 
function GetCurrentUserSid: string;
begin
result := SPGetSid.GetCurrentUserSid;
end;
 
function ExpandEnvironmentStrings(ATemplate: string): string;
var
buffer: array[0..MAX_PATH] of Char; // MAX_PATH ?
size: DWORD;
begin
size := SizeOf(buffer);
ZeroMemory(@buffer, size);
Windows.ExpandEnvironmentStrings(PChar(ATemplate), buffer, size);
SetString(result, buffer, lstrlen(buffer));
end;
 
function StrICmp(a, b: string): boolean;
begin
result := UpperCase(a) = UpperCase(b);
end;
 
function EnforceLength(s: string; len: integer; filler: char;
appendRight: boolean): string;
begin
result := s;
while (Length(result) < len) do
begin
if appendRight then
begin
result := result + filler;
end
else
begin
result := filler + result;
end;
end;
end;
 
function GetHomeDir: string;
var
reg: TRegistry;
begin
result := Functions.ExpandEnvironmentStrings('%HOMEDRIVE%%HOMEPATH%');
if result = '%HOMEDRIVE%%HOMEPATH%' then
begin
result := '';
// Windows 95
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion\ProfileReconciliation') then
begin
result := reg.ReadString('ProfileDirectory');
reg.CloseKey;
end;
finally;
reg.Free;
end;
end;
end;
 
end.
/trunk/UserDetect2/testuser/deltmp.bat
0,0 → 1,4
@echo off
 
del *.~*
del *.dcu
/trunk/UserDetect2/testuser/testuser.cfg
0,0 → 1,33
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
/trunk/UserDetect2/testuser/help.bat
0,0 → 1,5
@echo off
 
testuser
 
pause.
/trunk/UserDetect2/testuser/testuser.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/UserDetect2/testuser/example.bat
0,0 → 1,35
@echo off
 
ping kel > nul
if /I %ERRORLEVEL% EQU 0 call :backup_kel
 
testuser
 
testuser ":HOMECOMP:"
 
testuser ":HOMECOMP:" "\\SPR4200\C$\Dokumente und Einstellungen\Daniel Marschall"
if /I %ERRORLEVEL% EQU 0 goto backup_spr4200_dm
 
testuser ":HOMECOMP:" "\\SPR4200\C$\Dokumente und Einstellungen\Ursula Marschall"
if /I %ERRORLEVEL% EQU 0 goto backup_spr4200_um
 
goto end
 
REM -----------------------
 
:backup_kel
echo Remote backup script for host KEL
exit
 
REM -----------------------
 
:backup_spr4200_dm
echo Backup script for Daniel Marschall at SPR4200
goto end
 
:backup_spr4200_um
echo Backup script for Ursula Marschall at SPR4200
goto end
 
:end
pause.
/trunk/UserDetect2/testuser/icon.ico
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/trunk/UserDetect2/testuser/Tested with.txt
0,0 → 1,4
Tested with
 
- Windows 2000 SP4
- Windows 95b + IE4 (with and without profile usage)
/trunk/UserDetect2/testuser/testuser.dpr
0,0 → 1,143
program testuser;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
SysUtils,
Functions in 'Functions.pas';
 
type
EInvalidName = class(Exception);
 
const
C_TEMPLATES: array[0..5] of String =
('USER', 'COMP', 'SID', 'HOME', 'HOMESHARE', 'HOMECOMP');
 
resourcestring
C_TEMPLATE_MARKER = ':%s:';
C_EQUAL = '%s = %s';
 
function _GetArgExpect(param1: string): string;
resourcestring
LNG_EXCEPTION = 'Unknown value "%s"';
begin
if param1 = C_TEMPLATES[0] then
begin
result := Functions.GetUserName;
end
else if param1 = C_TEMPLATES[1] then
begin
result := Functions.GetComputerName;
end
else if param1 = C_TEMPLATES[2] then
begin
result := Functions.GetCurrentUserSid;
end
else if param1 = C_TEMPLATES[3] then
begin
result := Functions.GetHomeDir;
end
else if param1 = C_TEMPLATES[4] then
begin
result := ExpandEnvironmentStrings('%HOMESHARE%');
if result = '%HOMESHARE%' then result := '';
end
else if param1 = C_TEMPLATES[5] then
begin
result := Functions.GetHomeDir;
if result <> '' then
begin
result := '\\' + GetComputerName + '\' + StringReplace(result, ':', '$', []);
end;
end
else
begin
raise EInvalidName.CreateFmt(LNG_EXCEPTION, [param1]);
end;
end;
 
function _MaxTemplateLen: integer;
var
i, L: integer;
begin
result := -1;
for i := Low(C_TEMPLATES) to High(C_TEMPLATES) do
begin
L := Length(Format(C_TEMPLATE_MARKER, [C_TEMPLATES[i]]));
if L > result then result := L;
end;
end;
 
procedure _ShowSyntax;
resourcestring
LNG_SYNTAX_1 = 'Syntax:' + #13#10 + '%s [templateString] [comparisonValue]';
LNG_SYNTAX_2 = 'templateString may contain following variables:';
LNG_SYNTAX_3 = 'If comparisonValue is provided, the value will be compared with templateString ' + #13#10 +
'where variables are resolved. The ExitCode will be 0 if the values match ' + #13#10 +
'(case insensitive) or 1 if the value does not match.' + #13#10#13#10 +
'If comparisonValue is not provided, the value will be printed and the program' + #13#10 +
'terminates with ExitCode 0.';
var
i: integer;
s: string;
maxLen: integer;
begin
WriteLn(Format(LNG_SYNTAX_1, [UpperCase(ExtractFileName(ParamStr(0)))]));
WriteLn('');
WriteLn(LNG_SYNTAX_2);
maxLen := _MaxTemplateLen;
for i := Low(C_TEMPLATES) to High(C_TEMPLATES) do
begin
s := C_TEMPLATES[i];
WriteLn(Format(C_EQUAL, [EnforceLength(Format(C_TEMPLATE_MARKER, [s]),
maxLen, ' ', true), _GetArgExpect(s)]));
end;
WriteLn('');
WriteLn(LNG_SYNTAX_3);
WriteLn('');
end;
 
function _Expand(AInput: string): string;
var
i: integer;
s: string;
begin
result := AInput;
for i := Low(C_TEMPLATES) to High(C_TEMPLATES) do
begin
s := C_TEMPLATES[i];
result := StringReplace(result, Format(C_TEMPLATE_MARKER, [s]),
_GetArgExpect(s), [rfIgnoreCase, rfReplaceAll]);
end;
end;
 
function _Main: integer;
var
arg2expect: string;
begin
result := 0;
 
if (ParamCount() = 0) or (ParamCount() > 2) or (ParamStr(1) = '/?') then
begin
_ShowSyntax;
result := 2;
Exit;
end;
 
arg2expect := _Expand(ParamStr(1));
 
if ParamCount() = 1 then
begin
WriteLn(Format(C_EQUAL, [ParamStr(1), arg2expect]));
end
else if ParamCount() = 2 then
begin
if not StrICmp(ParamStr(2), arg2expect) then result := 1;
end;
end;
 
begin
ExitCode := _Main;
end.
/trunk/UserDetect2/testuser/todo.txt
0,0 → 1,0
Laufwerksserialnummer finden
/trunk/UserDetect2/testuser/SPGetSid.pas
0,0 → 1,159
(******************************************************************************)
(* SPGetSid - Retrieve the current user's SID in text format *)
(* *)
(* Copyright (c) 2004 Shorter Path Software *)
(* http://www.shorterpath.com *)
(******************************************************************************)
 
 
{
SID is a data structure of variable length that identifies user, group,
and computer accounts.
Every account on a network is issued a unique SID when the account is first created.
Internal processes in Windows refer to an account's SID
rather than the account's user or group name.
}
 
 
unit SPGetSid;
 
interface
 
uses
Windows, SysUtils;
 
function GetCurrentUserSid: string;
 
implementation
 
const
HEAP_ZERO_MEMORY = $00000008;
SID_REVISION = 1; // Current revision level
 
type
PTokenUser = ^TTokenUser;
TTokenUser = packed record
User: TSidAndAttributes;
end;
 
function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL;
var
psia: PSIDIdentifierAuthority;
dwSubAuthorities: DWORD;
dwSidRev: DWORD;
dwCounter: DWORD;
dwSidSize: DWORD;
begin
Result := False;
 
dwSidRev := SID_REVISION;
 
if not IsValidSid(Sid) then Exit;
 
psia := GetSidIdentifierAuthority(Sid);
 
dwSubAuthorities := GetSidSubAuthorityCount(Sid)^;
 
dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char);
 
if (dwBufferLen < dwSidSize) then
begin
dwBufferLen := dwSidSize;
SetLastError(ERROR_INSUFFICIENT_BUFFER);
Exit;
end;
 
StrFmt(pszSidText, 'S-%u-', [dwSidRev]);
 
if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then
StrFmt(pszSidText + StrLen(pszSidText),
'0x%.2x%.2x%.2x%.2x%.2x%.2x',
[psia.Value[0], psia.Value[1], psia.Value[2],
psia.Value[3], psia.Value[4], psia.Value[5]])
else
StrFmt(pszSidText + StrLen(pszSidText),
'%u',
[DWORD(psia.Value[5]) +
DWORD(psia.Value[4] shl 8) +
DWORD(psia.Value[3] shl 16) +
DWORD(psia.Value[2] shl 24)]);
 
dwSidSize := StrLen(pszSidText);
 
for dwCounter := 0 to dwSubAuthorities - 1 do
begin
StrFmt(pszSidText + dwSidSize, '-%u',
[GetSidSubAuthority(Sid, dwCounter)^]);
dwSidSize := StrLen(pszSidText);
end;
 
Result := True;
end;
 
function ObtainTextSid(hToken: THandle; pszSid: PChar;
var dwBufferLen: DWORD): BOOL;
var
dwReturnLength: DWORD;
dwTokenUserLength: DWORD;
tic: TTokenInformationClass;
ptu: Pointer;
begin
Result := False;
dwReturnLength := 0;
dwTokenUserLength := 0;
tic := TokenUser;
ptu := nil;
 
if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
dwReturnLength) then
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength);
if ptu = nil then Exit;
dwTokenUserLength := dwReturnLength;
dwReturnLength := 0;
 
if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
dwReturnLength) then Exit;
end
else
Exit;
end;
 
if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit;
 
if not HeapFree(GetProcessHeap, 0, ptu) then Exit;
 
Result := True;
end;
 
function GetCurrentUserSid: string;
var
hAccessToken: THandle;
bSuccess: BOOL;
dwBufferLen: DWORD;
szSid: array[0..260] of Char;
begin
Result := '';
 
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
hAccessToken);
end;
if bSuccess then
begin
ZeroMemory(@szSid, SizeOf(szSid));
dwBufferLen := SizeOf(szSid);
 
if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then
Result := szSid;
CloseHandle(hAccessToken);
end;
end;
 
end.
/trunk/UserDetect2/testuser/testuser.dof
0,0 → 1,90
[FileVersion]
Version=6.0
 
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
 
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=vcl;rtl;vclx;VclSmp;vclshlctrls;ZMstr190D6
Conditionals=
DebugSourceDirs=
UsePackages=0
 
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
 
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
 
[Version Info Keys]
CompanyName=ViaThinkSoft
FileDescription=Tests username and other values
FileVersion=1.0.0.0
InternalName=TestUser
LegalCopyright=Copyright 2012 ViaThinkSoft
LegalTrademarks=Keine
OriginalFilename=testuser.exe
ProductName=ViaThinkSoft Smart Delphi Utils
ProductVersion=1.0.0.0
Webseite=www.viathinksoft.de
Projektleiter=Daniel Marschall - www.daniel-marschall.de
/trunk/UserDetect2/testuser/testuser.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property