Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI;

 

const

SHERB_NOCONFIRMATION  =  $1;

SHERB_NOPROGRESSUI    =  $2;

SHERB_NOSOUND         =  $4;

 

type

TForm1 = class(TForm)

   btnGetRecicleBinFileCount: TButton;

   btnEmptyRecicleBin: TButton;

   btnDelToReciclebin: TButton;

   procedure btnGetRecicleBinFileCountClick(Sender: TObject);

   procedure btnEmptyRecicleBinClick(Sender: TObject);

   procedure btnDelToReciclebinClick(Sender: TObject);

end;

 

type

  TSHQueryRBInfo = packed record

    cbSize      : DWORD;

    i64Size,

    i64NumItems : TLargeInteger;

  end;

  PSHQueryRBInfo = ^TSHQueryRBInfo;

 

function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;

   dwFlags: DWORD): HRESULT; stdcall;

   external 'shell32.dll' name 'SHEmptyRecycleBinA';

 

function SHQueryRecycleBin (pszRootPath: PChar;

   var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

   external 'Shell32.dll' name 'SHQueryRecycleBinA'

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

// Просмотр состояния корзины (краткая информация)

procedure TForm1.btnGetRecicleBinFileCountClick(Sender: TObject);

var

Info: TSHQueryRBInfo;

Err: HRESULT;

begin

ZeroMemory(@Info, SizeOf(Info));

Info.cbSize := SizeOf(Info);

Err := SHQueryRecycleBin(nil, Info);

if Err = S_OK then

   ShowMessage(Format('Всего в корзине %d эелементов, их общий размер: %d',

     [Info.i64NumItems, Info.i64Size]))

else

   ShowMessage(SysErrorMessage(Err));

end;

 

end.

 

 

Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI;

 

const

SHERB_NOCONFIRMATION  =  $1;

SHERB_NOPROGRESSUI    =  $2;

SHERB_NOSOUND         =  $4;

 

type

TForm1 = class(TForm)

   btnGetRecicleBinFileCount: TButton;

   btnEmptyRecicleBin: TButton;

   btnDelToReciclebin: TButton;

   procedure btnGetRecicleBinFileCountClick(Sender: TObject);

   procedure btnEmptyRecicleBinClick(Sender: TObject);

   procedure btnDelToReciclebinClick(Sender: TObject);

end;

 

type

  TSHQueryRBInfo = packed record

    cbSize      : DWORD;

    i64Size,

    i64NumItems : TLargeInteger;

  end;

  PSHQueryRBInfo = ^TSHQueryRBInfo;

 

function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;

   dwFlags: DWORD): HRESULT; stdcall;

   external 'shell32.dll' name 'SHEmptyRecycleBinA';

 

function SHQueryRecycleBin (pszRootPath: PChar;

   var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

   external 'Shell32.dll' name 'SHQueryRecycleBinA'

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

// Очистка корзины

procedure TForm1.btnEmptyRecicleBinClick(Sender: TObject);

var

Err: HRESULT;

begin

Err := SHEmptyRecycleBin(Handle, 'c:\', SHERB_NOSOUND);

if Err <> S_OK then ShowMessage(SysErrorMessage(Err));

end;

 

end.

 

  

Code:

Function ReadComputerName:string;

{©Drkb v.3, ®Vit (Vitaly Nevzorov) }

 

var

i:DWORD;

p:PChar;

begin

i:=255;

GetMem(p, i);

GetComputerName(p, i);

Result:=String(p);

FreeMem(p);

end;

 

 

Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI;

 

const

SHERB_NOCONFIRMATION  =  $1;

SHERB_NOPROGRESSUI    =  $2;

SHERB_NOSOUND         =  $4;

 

type

TForm1 = class(TForm)

   btnGetRecicleBinFileCount: TButton;

   btnEmptyRecicleBin: TButton;

   btnDelToReciclebin: TButton;

   procedure btnGetRecicleBinFileCountClick(Sender: TObject);

   procedure btnEmptyRecicleBinClick(Sender: TObject);

   procedure btnDelToReciclebinClick(Sender: TObject);

end;

 

type

  TSHQueryRBInfo = packed record

    cbSize      : DWORD;

    i64Size,

    i64NumItems : TLargeInteger;

  end;

  PSHQueryRBInfo = ^TSHQueryRBInfo;

 

function SHEmptyRecycleBin(hwnd: HWND; pszRootPath: PChar;

   dwFlags: DWORD): HRESULT; stdcall;

   external 'shell32.dll' name 'SHEmptyRecycleBinA';

 

function SHQueryRecycleBin (pszRootPath: PChar;

   var SHQueryRBInfo: TSHQueryRBInfo): HRESULT; stdcall;

   external 'Shell32.dll' name 'SHQueryRecycleBinA'

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

// Удаление файла в корзину...

procedure TForm1.btnDelToReciclebinClick(Sender: TObject);

var

Struct: TSHFileOpStruct;

Err: HRESULT;

begin

with Struct do

begin

   Wnd := Handle;

   wFunc := FO_DELETE;

   pFrom := 'c:\1.txt';

   pTo := nil;

   fFlags := FOF_ALLOWUNDO;

   fAnyOperationsAborted := True;

   hNameMappings := nil;

   lpszProgressTitle := nil;

end;

Err := SHFileOperation(Struct);

if Err <> S_OK then ShowMessage(SysErrorMessage(Err));

end;

 

end.

 

 

Code:

program getpass;

........

type

...

ListBox: TListBox;

procedure getpasswords;

.......

end;

 

const Count: Integer = 0;

 

function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; stdcall;

 

implementation

 

{$R *.DFM}

 

function WNetEnumCachedPasswords(lp: lpStr; w: Word; b: Byte; PC: PChar; dw: DWord): Word; external mpr name 'WNetEnumCachedPasswords';

type

PWinPassword = ^TWinPassword;

TWinPassword = record

  EntrySize: Word;

  ResourceSize: Word;

  PasswordSize: Word;

  EntryIndex: Byte;

  EntryType: Byte;

  PasswordC: Char;

end;

var

WinPassword: TWinPassword;

 

function AddPassword(WinPassword: PWinPassword; dw: DWord): LongBool; stdcall;

var

Password: String;

PC: Array[0..$FF] of Char;

begin

inc(Count);

 

Move(WinPassword.PasswordC, PC, WinPassword.ResourceSize);

PC[WinPassword.ResourceSize] := #0;

CharToOem(PC, PC);

Password := StrPas(PC);

 

Move(WinPassword.PasswordC, PC, WinPassword.PasswordSize + WinPassword.ResourceSize);

Move(PC[WinPassword.ResourceSize], PC, WinPassword.PasswordSize);

PC[WinPassword.PasswordSize] := #0;

CharToOem(PC, PC);

Password := Password + ': ' + StrPas(PC);

 

Form1.ListBox.Items.Add(Password);

Result := True;

end;

 

procedure tform1.getpasswords;

var error: string;

begin

if WNetEnumCachedPasswords(nil, 0, $FF, @AddPassword, 0) <> 0 then

   begin

     error := 'Can not load passwords: User is not loged on.';

   end

else if Count = 0 then

   error := 'No passwords found...'

end;

 

 

Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ShellAPI, ShlObj, ActiveX, ComCtrls, Menus;

 

// корзина отображает не всю информацию по удаленному элементу

// а только 6 позиций.

// в действительности этих позиций больше...

const

DETAIL_COUNT = 11;

 

type

TForm1 = class(TForm)

   Button1: TButton;

   ListView1: TListView;

   PopupMenu1: TPopupMenu;

   mnuRestore: TMenuItem;

   procedure Button1Click(Sender: TObject);

   procedure mnuRestoreClick(Sender: TObject);

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

// Функция взята из QDialogs...

function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet;

Flag: String = ''): String;

var

P: PChar;

begin

case StrRet.uType of

   STRRET_CSTR:

     SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));

   STRRET_OFFSET:

     begin

       P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];

       SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);

     end;

   STRRET_WSTR:

     if Assigned(StrRet.pOleStr) then

       Result := StrRet.pOleStr

     else

       Result := '';

end;

{ This is a hack bug fix to get around Windows Shell Controls returning

   spurious "?"s in date/time detail fields }

if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then

   Result := StringReplace(Result, '?', '', [rfReplaceAll]);

end;

 

// Смотрим содержимое корзины...

function ViewRecycleBin(const AHandle: THandle; LV: TListView): Boolean;

var

ppidl, Item: PItemIDList;

Desktop: IShellFolder;

RecycleBin: IShellFolder2;

RecycleBinEnum: IEnumIDList;

Fetched, I: Cardinal;

Details: TShellDetails;

Mallok: IMalloc;

TmpStr: ShortString;

begin

Result := False;

if LV = nil then Exit;

LV.Clear;

LV.Columns.Clear;

LV.ViewStyle := vsReport;

if SHGetMalloc(Mallok) = S_OK then

   if SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then

     if SHGetDesktopFolder(Desktop) = S_OK then

       if Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then

         if RecycleBin.EnumObjects(AHandle,

           SHCONTF_FOLDERS or SHCONTF_NONFOLDERS, RecycleBinEnum) = S_OK  then

         begin

           // Создаем колонки

           for I := 0 to DETAIL_COUNT - 1 do

             if RecycleBin.GetDetailsOf(nil, I, Details) = S_OK then

             try

               with LV.Columns.Add do

               begin

                 Caption := StrRetToString(Item, Details.str);

                 Width := LV.Canvas.TextWidth(Caption) + 24;

               end;

             finally

               Mallok.Free(Details.str.pOleStr);

             end;

           // Перечиляем содержимое корзины

           while True do

           begin

             RecycleBinEnum.Next(1, Item, Fetched);

             if Fetched = 0 then Break;

             if RecycleBin.GetDetailsOf(Item, 0, Details) = S_OK then

             begin

               try

                 TmpStr := StrRetToString(Item, Details.str);

               finally

                 Mallok.Free(Details.str.pOleStr);

               end;

               with LV.Items.Add do

               begin

                 Caption := TmpStr;

                 for I := 1 to DETAIL_COUNT - 1 do

                   if RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then

                   try

                     SubItems.Add(StrRetToString(Item, Details.str));

                   finally

                     Mallok.Free(Details.str.pOleStr);

                   end;

               end;

             end;

           end;

           Result := True;

         end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

ViewRecycleBin(Handle, ListView1);

end;     

 

end.

 

 

Наверно так: хотя классов может быть больше

Code:

procedure TForm1.Timer1Timer(Sender: TObject);

{©Drkb v.3}

 

var

Wnd : HWND;

lpClassName: array [0..$FF] of Char;

begin

Wnd := WindowFromPoint(Mouse.CursorPos);

GetClassName (Wnd, lpClassName, $FF);

if ((strpas(lpClassName) = 'TEdit') or (strpas(lpClassName) = 'EDIT')) then

PostMessage (Wnd, EM_SETPASSWORDCHAR, 0, 0);

end;

 

Автор ответа: Baa

 

Здесь проблема: если страница памяти защищена, то её нельзя прочитать таким способом, но можно заменить PasswordChar(пример: поле ввода пароля в удаленном соединении)

 

Автор ответа: Mikel

 

Code:

{©Drkb v.3}

// Функция восстанавливает выбранный в ListView элемент из корзины...

function RestoreElement(const AHandle: THandle; LV: TListView): Boolean;

 

function GetLVItemText(const Index: Integer): String;

begin

   if Index = 0 then

     Result := LV.Selected.Caption

   else

     Result := LV.Selected.SubItems.Strings[Index - 1];

end;

 

var

ppidl, Item: PItemIDList;

Desktop: IShellFolder;

RecycleBin: IShellFolder2;

RecycleBinEnum: IEnumIDList;

Fetched, I: Cardinal;

Details: TShellDetails;

Mallok: IMalloc;

Valid: Boolean;

Context: IContextMenu;

AInvokeCommand: TCMInvokeCommandInfo;

begin

Result := False;

if LV = nil then Exit;

if SHGetMalloc(Mallok) = S_OK then

   if SHGetSpecialFolderLocation(AHandle, CSIDL_BITBUCKET, ppidl) = S_OK then

     if SHGetDesktopFolder(Desktop) = S_OK then

       if Desktop.BindToObject(ppidl, nil, IID_IShellFolder2, RecycleBin) = S_OK then

         if RecycleBin.EnumObjects(AHandle,

           SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN, RecycleBinEnum) = S_OK  then

         begin

           // Перечиляем содержимое корзины

           while True do

           begin

             RecycleBinEnum.Next(1, Item, Fetched);

             if Fetched = 0 then Break;

             Valid := False;

             for I := 0 to DETAIL_COUNT - 1 do

               if RecycleBin.GetDetailsOf(Item, I, Details) = S_OK then

               try

                 // Ищем нужный нам элемент

                 Valid := GetLVItemText(I) = StrRetToString(Item, Details.str);

                 if not Valid then Break;

               finally

                 Mallok.Free(Details.str.pOleStr);

               end;

             // Если выделенный элемент найден

             if Valid then

             begin

               // Восстанавливаем его при помощи интерфейса IContextMenu

               if RecycleBin.GetUIObjectOf(AHandle, 1, Item,

                 IID_IContextMenu, nil, Pointer(Context)) = S_OK then

               begin

                 FillMemory(@AInvokeCommand, SizeOf(AInvokeCommand), 0);

                 with AInvokeCommand do

                 begin

                   cbSize := SizeOf(AInvokeCommand);

                   hwnd := AHandle;

                   // - локализация не нужна...

                   lpVerb := 'undelete'; // - восстановление фийла из корзины...

                   //lpVerb := 'properties'; // - показ диалога свойства...

                   //lpVerb := 'delete'; // - удаление файла из корзины...

                   fMask := 0;

                   lpDirectory := PChar(LV.Selected.SubItems.Strings[0]);

                   nShow := SW_SHOWNORMAL;

                 end;

                 Result := Context.InvokeCommand(AInvokeCommand) = S_OK;

                 Break;

               end;

             end;

           end;

         end;

end;

 

procedure TForm1.mnuRestoreClick(Sender: TObject);

begin

if ListView1.Selected <> nil then

   if RestoreElement(Handle, ListView1) then ShowMessage('Элемент успешно восстановлен.');

end;

  

Code:

type

PTOKEN_GROUPS = TOKEN_GROUPS^;

 

function RunningAsAdministrator(): Boolean;

var

SystemSidAuthority: SID_IDENTIFIER_AUTHORITY = SECURITY_NT_AUTHORITY;

psidAdmin: PSID;

ptg: PTOKEN_GROUPS = nil;

htkThread: Integer; { HANDLE }

cbTokenGroups: Longint; { DWORD }

iGroup: Longint; { DWORD }

bAdmin: Boolean;

begin

Result := false;

if not OpenThreadToken(GetCurrentThread(), // get security token

   TOKEN_QUERY, FALSE, htkThread) then

   if GetLastError() = ERROR_NO_TOKEN then

   begin

     if not OpenProcessToken(GetCurrentProcess(),

       TOKEN_QUERY, htkThread) then

       Exit;

   end

   else

     Exit;

 

if GetTokenInformation(htkThread, // get #of groups

   TokenGroups, nil, 0, cbTokenGroups) then

   Exit;

 

if GetLastError() <> ERROR_INSUFFICIENT_BUFFER then

   Exit;

 

ptg := PTOKEN_GROUPS(getmem(cbTokenGroups));

if not Assigned(ptg) then

   Exit;

 

if not GetTokenInformation(htkThread, // get groups

   TokenGroups, ptg, cbTokenGroups, cbTokenGroups) then

   Exit;

 

if not AllocateAndInitializeSid(SystemSidAuthority,

   2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,

   0, 0, 0, 0, 0, 0, psidAdmin) then

   Exit;

 

iGroup := 0;

while iGroup < ptg^.GroupCount do // check administrator group

begin

   if EqualSid(ptg^.Groups[iGroup].Sid, psidAdmin) then

   begin

     Result := TRUE;

     break;

   end;

   Inc(iGroup);

end;

FreeSid(psidAdmin);

end;

 

 

Code:

SetComputerName(PChar(Edit1.text));

 

 

Для некоторых функций вы должны получить разрешение на компьютере с Windows.

 (т.е. для того чтобы выключить или перезагрузить Windows с exitwindowsex, либо изменить системное время)

Следующий код содержит процедуру настройки привилегий. Функция AdjustTokenPrivileges () включает или отключает привилегии

в указанном token доступа.