| /trunk/vcl/ViaThinkSoft.dpk |
|---|
| 0,0 → 1,41 |
| package dclusr; |
| {$R *.res} |
| {$ALIGN 8} |
| { ASSERTIONS ON} |
| {$BOOLEVAL OFF} |
| { DEBUGINFO OFF} |
| {$EXTENDEDSYNTAX ON} |
| {$IMPORTEDDATA ON} |
| {$IOCHECKS ON} |
| { LOCALSYMBOLS OFF} |
| {$LONGSTRINGS ON} |
| {$OPENSTRINGS ON} |
| {$OPTIMIZATION ON} |
| {$OVERFLOWCHECKS OFF} |
| {$RANGECHECKS OFF} |
| {$REFERENCEINFO OFF} |
| {$SAFEDIVIDE OFF} |
| { STACKFRAMES OFF} |
| {$TYPEDADDRESS OFF} |
| {$VARSTRINGCHECKS ON} |
| {$WRITEABLECONST ON} |
| {$MINENUMSIZE 1} |
| {$IMAGEBASE $51000000} |
| {$DESCRIPTION 'ViaThinkSoft VCL Components'} |
| {$LIBSUFFIX '60'} |
| {$DESIGNONLY} |
| {$IMPLICITBUILD ON} |
| requires |
| rtl, |
| vcl, |
| designide; |
| contains |
| VTSListView in 'VTSListView.pas', |
| AlphaNumSort in 'AlphaNumSort.pas', |
| VTSCompat in 'VTSCompat.pas', |
| PatchU in 'PatchU.pas'; |
| end. |
| /trunk/vcl/AlphaNumSort.pas |
|---|
| 0,0 → 1,122 |
| unit AlphaNumSort; |
| (* |
| * The Alphanum Algorithm is an improved sorting algorithm for strings |
| * containing numbers. Instead of sorting numbers in ASCII order like |
| * a standard sort, this algorithm sorts numbers in numeric order. |
| * |
| * The Alphanum Algorithm is discussed at http://www.DaveKoelle.com |
| * |
| * Translated from Java to Delphi by Daniel Marschall, www.daniel-marschall.de |
| * Revision 2015-09-30 |
| * |
| * |
| * This library is free software; you can redistribute it and/or |
| * modify it under the terms of the GNU Lesser General Public |
| * License as published by the Free Software Foundation; either |
| * version 2.1 of the License, or any later version. |
| * |
| * This library is distributed in the hope that it will be useful, |
| * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| * Lesser General Public License for more details. |
| * |
| * You should have received a copy of the GNU Lesser General Public |
| * License along with this library; if not, write to the Free Software |
| * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
| * |
| *) |
| interface |
| uses |
| SysUtils; |
| function AlphaNumCompare(s1, s2: string): integer; |
| implementation |
| function isDigit(ch: char): boolean; |
| begin |
| result := (ord(ch) >= 48) and (ord(ch) <= 57); |
| end; |
| // Length of string is passed in for improved efficiency (only need to calculate it once) |
| function getChunk(s: string; slength, marker: integer): string; |
| var |
| chunk: string; |
| c: char; |
| begin |
| c := s[marker+1]; |
| chunk := chunk + c; |
| Inc(marker); |
| if isDigit(c) then |
| begin |
| while marker < slength do |
| begin |
| c := s[marker+1]; |
| if not isDigit(c) then break; |
| chunk := chunk + c; |
| Inc(marker); |
| end; |
| end |
| else |
| begin |
| while marker < slength do |
| begin |
| c := s[marker+1]; |
| if (isDigit(c)) then break; |
| chunk := chunk + c; |
| Inc(marker); |
| end; |
| end; |
| result := chunk; |
| end; |
| function AlphaNumCompare(s1, s2: string): integer; |
| var |
| s1Length, s2Length, thisChunkLength: integer; |
| thisMarker, thatMarker, i: integer; |
| thisChunk, thatChunk: string; |
| begin |
| thisMarker := 0; |
| thatMarker := 0; |
| s1Length := Length(s1); |
| s2Length := Length(s2); |
| while (thisMarker < s1Length) and (thatMarker < s2Length) do |
| begin |
| thisChunk := getChunk(s1, s1Length, thisMarker); |
| Inc(thisMarker, Length(thisChunk)); |
| thatChunk := getChunk(s2, s2Length, thatMarker); |
| Inc(thatMarker, Length(thatChunk)); |
| // If both chunks contain numeric characters, sort them numerically |
| if isDigit(thisChunk[1]) and isDigit(thatChunk[1]) then |
| begin |
| // Simple chunk comparison by length. |
| thisChunkLength := Length(thisChunk); |
| result := thisChunkLength - Length(thatChunk); |
| // If equal, the first different number counts |
| if result = 0 then |
| begin |
| for i := 0 to thisChunkLength-1 do |
| begin |
| result := ord(thisChunk[i+1]) - ord(thatChunk[i+1]); |
| if result <> 0 then Exit; |
| end; |
| end; |
| end |
| else |
| begin |
| result := CompareText(thisChunk, thatChunk); |
| end; |
| if result <> 0 then Exit; |
| end; |
| result := s1Length - s2Length; |
| end; |
| end. |
| /trunk/vcl/VTSCompat.pas |
|---|
| 0,0 → 1,197 |
| unit VTSCompat; |
| {$IF CompilerVersion >= 25.0} |
| {$LEGACYIFEND ON} |
| {$IFEND} |
| interface |
| uses |
| Dialogs, Windows, Controls, Graphics, SysUtils, CommDlg, Classes; |
| function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon): integer; |
| function CompatOpenDialogExecute(OpenDialog: TOpenDialog): boolean; |
| function CompatSaveDialogExecute(SaveDialog: TSaveDialog): boolean; |
| implementation |
| uses |
| PatchU, ShlObj, ShellAPI; |
| var |
| pp: TPatchMethod; |
| // --- CompatOpenDialogExecute |
| type |
| TExtOpenDialogAccessor = class(TOpenDialog); |
| TExtOpenDialog = class(TOpenDialog) |
| protected |
| function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override; |
| end; |
| function TExtOpenDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; |
| begin |
| TOpenFileName(DialogData).Flags := |
| TOpenFileName(DialogData).Flags and not OFN_ENABLETEMPLATE; |
| TOpenFileName(DialogData).Flags := |
| TOpenFileName(DialogData).Flags and not OFN_ENABLEHOOK; |
| if pp.IsPatched then pp.Restore; |
| result := inherited TaskModalDialog(DialogFunc, DialogData); |
| end; |
| function CompatOpenDialogExecute(OpenDialog: TOpenDialog): boolean; |
| {$IF CompilerVersion < 18.5} // prior to Delphi 2007 |
| var |
| x: TExtOpenDialog; |
| MethodPtr, MethodPtr2: function(DialogFunc: Pointer; var DialogData): Bool of object; |
| begin |
| MethodPtr := TExtOpenDialogAccessor(OpenDialog).TaskModalDialog; |
| x := TExtOpenDialog.Create(nil); |
| try |
| MethodPtr2 := x.TaskModalDialog; |
| pp := TPatchMethod.Create(@MethodPtr, @MethodPtr2); |
| try |
| result := OpenDialog.Execute; |
| if pp.IsPatched then pp.Restore; |
| finally |
| pp.Free; |
| end; |
| finally |
| x.Free; |
| end; |
| {$ELSE} |
| begin |
| result := OpenDialog.Execute; |
| {$IFEND} |
| end; |
| // --- CompatSaveDialogExecute |
| type |
| TExtSaveDialogAccessor = class(TSaveDialog); |
| TExtSaveDialog = class(TSaveDialog) |
| protected |
| function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; override; |
| end; |
| function TExtSaveDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool; |
| begin |
| // Remove the two flags which let the File Dialog GUI fall back to the old design. |
| TOpenFileName(DialogData).Flags := |
| TOpenFileName(DialogData).Flags and not OFN_ENABLETEMPLATE; |
| TOpenFileName(DialogData).Flags := |
| TOpenFileName(DialogData).Flags and not OFN_ENABLEHOOK; |
| // It is important to restore TaskModalDialog, so we don't get a stack |
| // overflow when calling the inherited method. |
| if pp.IsPatched then pp.Restore; |
| result := inherited TaskModalDialog(DialogFunc, DialogData); |
| end; |
| function CompatSaveDialogExecute(SaveDialog: TSaveDialog): boolean; |
| {$IF CompilerVersion < 18.5} // prior to Delphi 2007 |
| var |
| x: TExtSaveDialog; |
| MethodPtr, MethodPtr2: function(DialogFunc: Pointer; var DialogData): Bool of object; |
| begin |
| MethodPtr := TExtSaveDialogAccessor(SaveDialog).TaskModalDialog; |
| x := TExtSaveDialog.Create(nil); |
| try |
| MethodPtr2 := x.TaskModalDialog; |
| pp := TPatchMethod.Create(@MethodPtr, @MethodPtr2); |
| try |
| result := SaveDialog.Execute; |
| finally |
| pp.Free; |
| end; |
| finally |
| x.Free; |
| end; |
| {$ELSE} |
| begin |
| result := OpenDialog.Execute; |
| {$IFEND} |
| end; |
| // --- AddTransparentIconToImageList |
| function RealIconSize(H: HIcon): TPoint; |
| // http://www.delphipages.com/forum/showthread.php?t=183999 |
| var |
| IconInfo: TIconInfo; |
| bmpmask: TBitmap; |
| begin |
| result := Point(0, 0); |
| if H <> 0 then |
| begin |
| bmpmask := TBitmap.Create; |
| try |
| IconInfo.fIcon := true; |
| try |
| GetIconInfo(H, IconInfo); |
| bmpmask.Handle := IconInfo.hbmMask; |
| bmpmask.Dormant; //lets us free the resource without 'losing' the bitmap |
| finally |
| DeleteObject(IconInfo.hbmMask); |
| DeleteObject(IconInfo.hbmColor) |
| end; |
| result := Point(bmpmask.Width, bmpmask.Height); |
| finally |
| bmpmask.Free; |
| end; |
| end; |
| end; |
| function AddTransparentIconToImageList(ImageList: TImageList; Icon: TIcon): integer; |
| // http://www.delphipages.com/forum/showthread.php?t=183999 |
| var |
| buffer, mask: TBitmap; |
| p: TPoint; |
| begin |
| // result := ImageList.AddIcon(ico); |
| // --> In Delphi 6, Icons with half-transparency have a black border (e.g. in ListView) |
| p := RealIconSize(icon.handle); |
| buffer := TBitmap.Create; |
| mask := TBitmap.Create; |
| try |
| buffer.PixelFormat := pf24bit; |
| mask.PixelFormat := pf24bit; |
| buffer.Width := p.X; |
| buffer.Height := p.Y; |
| buffer.Canvas.Draw(0, 0, icon); |
| buffer.Transparent := true; |
| buffer.TransparentColor := buffer.Canvas.Pixels[0,0]; |
| if (ImageList.Width <> p.X) or (ImageLIst.Height <> p.Y) then |
| begin |
| ImageList.Width := p.X; |
| ImageList.Height := p.Y; |
| end; |
| // create a mask for the icon. |
| mask.Assign(buffer); |
| mask.Canvas.Brush.Color := buffer.Canvas.Pixels[0, buffer.Height -1]; |
| mask.Monochrome := true; |
| result := ImageList.Add(buffer, mask); |
| finally |
| mask.Free; |
| buffer.Free; |
| end; |
| end; |
| end. |
| /trunk/vcl/VTSListView.pas |
|---|
| 0,0 → 1,129 |
| unit VTSListView; |
| interface |
| // This ListView adds support for sorting arrows |
| // Recommended usage for the OnCompare event: |
| (* |
| procedure TForm1.ListViewCompare(Sender: TObject; Item1, |
| Item2: TListItem; Data: Integer; var Compare: Integer); |
| var |
| ListView: TVTSListView; |
| begin |
| ListView := Sender as TVTSListView; |
| if ListView.CurSortedColumn = 0 then |
| begin |
| Compare := CompareText(Item1.Caption, Item2.Caption); |
| end |
| else |
| begin |
| Compare := CompareText(Item1.SubItems[ListView.CurSortedColumn-1], |
| Item2.SubItems[ListView.CurSortedColumn-1]); |
| end; |
| if ListView.CurSortedDesc then Compare := -Compare; |
| end; |
| *) |
| uses |
| Windows, Messages, SysUtils, Classes, Controls, ComCtrls, CommCtrl; |
| type |
| TVTSListView = class(TListView) |
| private |
| FDescending: Boolean; |
| FSortedColumn: Integer; |
| procedure WMNotifyMessage(var msg: TWMNotify); message WM_NOTIFY; |
| protected |
| procedure ShowArrowOfListViewColumn; |
| procedure ColClick(Column: TListColumn); override; |
| public |
| constructor Create(AOwner: TComponent); override; |
| published |
| property CurSortedColumn: integer read FSortedColumn; |
| property CurSortedDesc: boolean read FDescending; |
| end; |
| procedure Register; |
| implementation |
| // The arrows require a XP Manifest |
| {$IF not Declared(HDF_SORTUP)} |
| const |
| { For Windows >= XP } |
| {$EXTERNALSYM HDF_SORTUP} |
| HDF_SORTUP = $0400; |
| {$EXTERNALSYM HDF_SORTDOWN} |
| HDF_SORTDOWN = $0200; |
| {$IFEND} |
| { TVTSListView } |
| constructor TVTSListView.Create(AOwner: TComponent); |
| begin |
| inherited; |
| FSortedColumn := -1; |
| end; |
| procedure TVTSListView.ShowArrowOfListViewColumn; |
| var |
| Header: HWND; |
| Item: THDItem; |
| i: integer; |
| begin |
| Header := ListView_GetHeader(Handle); |
| ZeroMemory(@Item, SizeOf(Item)); |
| Item.Mask := HDI_FORMAT; |
| // Remove arrows |
| for i := 0 to Columns.Count-1 do |
| begin |
| Header_GetItem(Header, i, Item); |
| Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN); |
| Header_SetItem(Header, i, Item); |
| end; |
| // Add arrow |
| Header_GetItem(Header, FSortedColumn, Item); |
| if FDescending then |
| Item.fmt := Item.fmt or HDF_SORTDOWN |
| else |
| Item.fmt := Item.fmt or HDF_SORTUP; |
| Header_SetItem(Header, FSortedColumn, Item); |
| end; |
| procedure TVTSListView.WMNotifyMessage(var msg: TWMNotify); |
| begin |
| inherited; |
| if (Msg.NMHdr^.code = HDN_ENDTRACK) and (FSortedColumn > -1) then |
| begin |
| ShowArrowOfListViewColumn; |
| end; |
| end; |
| procedure TVTSListView.ColClick(Column: TListColumn); |
| begin |
| if not Assigned(OnCompare) then Exit; |
| SortType := stNone; |
| if Column.Index <> FSortedColumn then |
| begin |
| FSortedColumn := Column.Index; |
| FDescending := False; |
| end |
| else |
| begin |
| FDescending := not FDescending; |
| end; |
| ShowArrowOfListViewColumn; |
| SortType := stText; |
| inherited; |
| end; |
| procedure Register; |
| begin |
| RegisterComponents('ViaThinkSoft', [TVTSListView]); |
| end; |
| end. |
| /trunk/vcl/PatchU.pas |
|---|
| 0,0 → 1,70 |
| unit PatchU; |
| interface |
| type |
| pPatchEvent = ^TPatchEvent; |
| // "Asm" opcode hack to patch an existing routine |
| TPatchEvent = packed record |
| Jump: Byte; |
| Offset: Integer; |
| end; |
| TPatchMethod = class |
| private |
| PatchedMethod, OriginalMethod: TPatchEvent; |
| PatchPositionMethod: pPatchEvent; |
| FIsPatched: boolean; |
| public |
| property IsPatched: boolean read FIsPatched; |
| constructor Create(const aSource, aDestination: Pointer); |
| destructor Destroy; override; |
| procedure Restore; |
| procedure Hook; |
| end; |
| implementation |
| uses |
| Windows, Sysutils; |
| { TPatchMethod } |
| constructor TPatchMethod.Create(const aSource, aDestination: Pointer); |
| var |
| OldProtect: Cardinal; |
| begin |
| PatchPositionMethod := pPatchEvent(aSource); |
| OriginalMethod := PatchPositionMethod^; |
| PatchedMethod.Jump := $E9; |
| PatchedMethod.Offset := Integer(PByte(aDestination)) - Integer(PByte(PatchPositionMethod)) - SizeOf(TPatchEvent); |
| if not VirtualProtect(PatchPositionMethod, SizeOf(TPatchEvent), PAGE_EXECUTE_READWRITE, OldProtect) then |
| RaiseLastOSError; |
| Hook; |
| end; |
| destructor TPatchMethod.Destroy; |
| begin |
| Restore; |
| inherited; |
| end; |
| procedure TPatchMethod.Hook; |
| begin |
| if FIsPatched then Exit; |
| FIsPatched := true; |
| PatchPositionMethod^ := PatchedMethod; |
| end; |
| procedure TPatchMethod.Restore; |
| begin |
| if not FIsPatched then Exit; |
| FIsPatched := false; |
| PatchPositionMethod^ := OriginalMethod; |
| end; |
| end. |
| /trunk/UserDetect2/vcl/AlphaNumSort.pas |
|---|
| File deleted |
| /trunk/UserDetect2/vcl/VTSCompat.pas |
|---|
| File deleted |
| /trunk/UserDetect2/vcl/VTSListView.pas |
|---|
| File deleted |
| /trunk/UserDetect2/vcl/ViaThinkSoft.dpk |
|---|
| File deleted |
| /trunk/UserDetect2/vcl/PatchU.pas |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/deltmp.bat |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/Functions.pas |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/testuser.cfg |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/help.bat |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/testuser.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Deleted: svn:mime-type |
| -application/octet-stream |
| \ No newline at end of property |
| /trunk/UserDetect2/testuser/example.bat |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/icon.ico |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Deleted: svn:mime-type |
| -application/octet-stream |
| \ No newline at end of property |
| /trunk/UserDetect2/testuser/testuser.dpr |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/Tested with.txt |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/todo.txt |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/SPGetSid.pas |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/testuser.dof |
|---|
| File deleted |
| /trunk/UserDetect2/testuser/testuser.res |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Deleted: svn:mime-type |
| -application/octet-stream |
| \ No newline at end of property |
| /trunk/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/testuser/deltmp.bat |
|---|
| 0,0 → 1,4 |
| @echo off |
| del *.~* |
| del *.dcu |
| /trunk/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/testuser/help.bat |
|---|
| 0,0 → 1,5 |
| @echo off |
| testuser |
| pause. |
| /trunk/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/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/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/testuser/Tested with.txt |
|---|
| 0,0 → 1,4 |
| Tested with |
| - Windows 2000 SP4 |
| - Windows 95b + IE4 (with and without profile usage) |
| /trunk/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/testuser/todo.txt |
|---|
| 0,0 → 1,0 |
| Laufwerksserialnummer finden |
| /trunk/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/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/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 |