nyuuzyou/wikis huggingface dataset:
Как получить дескриптор окна консоли

=== Как получить дескриптор окна консоли ===
В следующем примере используется функция Windows API FindWindow(). Обратите внимание, что WndClass консольного окна отличаются для Windows 95 и Window NT и заголовок окна может содержать полный путь под Windows NT.
procedure TForm1.Button1Click(Sender: TObject);
var
 info: TOSVersionInfo;
 ClassName: string;
 Title: string;
begin
 { Проверяем - Win95 или NT. }
 info.dwOSVersionInfoSize := SizeOf(info);
 GetVersionEx(info);
 if (info.dwPlatformId = VER_PLATFORM_WIN32_NT) then
 begin
 ClassName := 'ConsoleWindowClass';
 Title := 'Command Prompt';
 end
 else
 begin
 ClassName := 'tty';
 Title := 'MS-DOS Prompt';
 end;
 ShowMessage(IntToStr(FindWindow(PChar(ClassName), PChar(Title))));
end;
Source: http://delphiworld.narod.ru/
ID: 02196
----
При поиске окон, как отмечалось, нужен класс и имя, так вот - если Вы ищите DOS-окно, то его класс всегда = 'tty'.
Source: http://delphiworld.narod.ru/
ID: 02197
Как получить длинное имя файла или каталога, зная короткое имя?

=== Как получить длинное имя файла или каталога, зная короткое имя? ===
Используйте Win32_Find_Data поле TSearchRec.
procedure TForm1.Button1Click(Sender: TObject);
var
 SearchRec: TSearchRec;
 Success: Integer;
begin
 Success := SysUtils.FindFirst('C:\DownLoad\dial-u~1.htm', faAnyFile, SearchRec);
 if Success = 0 then
 begin
 ShowMessage(SearchRec.FindData.CFileName);
 end;
 SysUtils.FindClose(SearchRec);
end;
Author: P.O.D.
Source: Взято из http://forum.sources.ru
ID: 03165
----
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 end;
 function GetLongPathNameA(lpszShortPath, lpszLongPath: PChar;
 cchBuffer: DWORD): DWORD; stdcall; external kernel32;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function ExpandFileName(Path: String): String;
begin
 SetLength(Result, MAX_PATH);
 if GetLongPathNameA(PChar(Path), @Result[1], MAX_PATH) = 0 then
 RaiseLastOSError;
 Result := Trim(Result);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 S: String;
begin
 // Получаем полное имя
 S := ExpandFileName('C:\DOCUME~1\');
 ShowMessage(S);
 // Получаем урезанное имя
 GetShortPathName(PChar(S), PChar(S), MAX_PATH);
 ShowMessage(S);
end;
end.
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 03166
Category:Файловая система
Как получить длину wav в секундах?

uses
 MPlayer, MMsystem;
type
 EMyMCIException = class(Exception);
 TWavHeader = record
 Marker1: array[0..3] of Char;
 BytesFollowing: Longint;
 Marker2: array[0..3] of Char;
 Marker3: array[0..3] of Char;
 Fixed1: Longint;
 FormatTag: Word;
 Channels: Word;
 SampleRate: Longint;
 BytesPerSecond: Longint;
 BytesPerSample: Word;
 BitsPerSample: Word;
 Marker4: array[0..3] of Char;
 DataBytes: Longint;
 end;
procedure TForm1.Button1Click(Sender: TObject);
var
 Header: TWavHeader;
begin
 with TFileStream.Create('C:\SomeFile.wav', fmOpenRead) do
 try
 ReadBuffer(Header, SizeOf(Header));
 finally
 Free;
 end;
 ShowMessage(FloatToStr((Int64(1000) * header.DataBytes div header.BytesPerSecond) / 1000));
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03618
Category:Звук
Как получить доступ к битам переменной и управлять их значением?

=== Как получить доступ к битам переменной и управлять их значением? ===
unit Bitwise;
interface
function IsBitSet(const val: longint; const TheBit: byte): boolean;
function BitOn(const val: longint; const TheBit: byte): LongInt;
function BitOff(const val: longint; const TheBit: byte): LongInt;
function BitToggle(const val: longint; const TheBit: byte): LongInt;
implementation
function IsBitSet(const val: longint; const TheBit: byte): boolean;
begin
 result := (val and (1 shl TheBit)) <> 0;
end;
function BitOn(const val: longint; const TheBit: byte): LongInt;
begin
 result := val or (1 shl TheBit);
end;
function BitOff(const val: longint; const TheBit: byte): LongInt;
begin
 result := val and ((1 shl TheBit) xor $FFFFFFFF);
end;
function BitToggle(const val: longint; const TheBit: byte): LongInt;
begin
 result := val xor (1 shl TheBit);
end;
end.
ID: 00218
----
 SetWord - слово, которое необходимо установить.
 BitNum - номер бита, который необходимо выставить согласно определениям в секции const (Bit0, Bit1 и др.).
 GetBitStat возвращает значение True, если бит установлен и False - в противном случае.
const
 Bit0 = 1;
 Bit1 = 2;
 Bit2 = 4;
 Bit3 = 8;
 Bit4 = 16;
 Bit5 = 32;
 Bit6 = 64;
 Bit7 = 128;
 Bit8 = 256;
 Bit9 = 512;
 Bit10 = 1024;
 Bit11 = 2048;
 Bit12 = 4096;
 Bit13 = 8192;
 Bit14 = 16384;
 Bit15 = 32768;
procedure SetBit(SetWord, BitNum: Word);
begin
 SetWord := SetWord Or BitNum; { Устанавливаем бит }
end;
procedure ClearBit(SetWord, BitNum: Word);
begin
 SetWord := SetWord Or BitNum; { Устанавливаем бит }
 SetWord := SetWord Xor BitNum; { Переключаем бит }
end;
procedure ToggleBit(SetWord, BitNum: Word);
begin
 SetWord := SetWord Xor BitNum; { Переключаем бит }
end;
function GetBitStat(SetWord, BitNum: Word): Boolean;
begin
 GetBitStat := SetWord and BitNum = BitNum; { Если бит установлен }
end;
Источник: Книга В. Озерова "Delphi. Советы программистов"
Author: StayAtHome
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00219
Как получить доступ к объекту метафайла

Below is an example of getting metafile information and enumerating each metafile record:
function MyEnhMetaFileProc(DC: HDC; { handle to device context }
 lpHTable: PHANDLETABLE; { pointer to metafile handle table }
 lpEMFR: PENHMETARECORD; { pointer to metafile record }
 nObj: Integer; { count of objects }
 TheForm: TForm1): Integer; stdcall;
begin
 { draw the metafile record }
 PlayEnhMetaFileRecord(dc, lpHTable^, lpEMFR^, nObj);
 { set to zero to stop metafile enumeration }
 Result := 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 MyMetafile: TMetafile;
 lpENHMETAHEADER: PENHMETAHEADER; { extra metafile info }
 lpENHMETAHEADERSIZE: DWORD;
 NumMetaRecords: DWORD;
begin
 { Create a metafile }
 MyMetafile := TMetafile.Create;
 with TMetafileCanvas.Create(MyMetafile, 0) do
 try
 Brush.Color := clRed;
 Ellipse(0, 0, 100, 100);
 Ellipse(100, 100, 200, 200);
 Ellipse(200, 200, 300, 300);
 Ellipse(300, 300, 400, 400);
 Ellipse(400, 400, 500, 500);
 Ellipse(500, 500, 600, 600);
 finally
 Free;
 end;
 { we might as well get some extra metafile info }
 lpENHMETAHEADERSIZE := GetEnhMetaFileHeader(MyMetafile.Handle, 0, nil);
 NumMetaRecords := 0;
 if (lpENHMETAHEADERSIZE > 0) then
 begin
 GetMem(lpENHMETAHEADER, lpENHMETAHEADERSIZE);
 GetEnhMetaFileHeader(MyMetafile.Handle, lpENHMETAHEADERSIZE, lpENHMETAHEADER);
 { Here is an example of getting number of metafile records }
 NumMetaRecords := lpENHMETAHEADER^.nRecords;
 { enumerate the records }
 EnumEnhMetaFile(Canvas.Handle, MyMetafile.Handle, @MyEnhMetaFileProc, self,
 Rect(0, 0, 600, 600));
 FreeMem(lpENHMETAHEADER, lpENHMETAHEADERSIZE);
 end;
 MyMetafile.Free;
end;
Source: http://www.baltsoft.com/
ID: 03814
Category:Графика
Как получить закэшированные пароли в Win9x?

=== Как получить закэшированные пароли в Win9x? ===
program getpass; 
interface
type
 Form1 = class(TForm)
 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;
Source: Взято из http://forum.sources.ru
ID: 01717
Как получить значение свойства в виде варианта по тексту имени свойства?

=== Как получить значение свойства в виде варианта по тексту имени свойства? ===
unit MorePropInfo;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
 TFrmMorePropInfo = class(TForm)
 Button1: TButton;
 Button2: TButton;
 ListBox1: TListBox;
 procedure Button2Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 FrmMorePropInfo: TFrmMorePropInfo;
implementation
{$R *.DFM}
uses
 TypInfo;
procedure GetPropertyValues(AObj: TObject; AValues: TStrings);
var
 count: integer;
 data: PTypeData;
 default: string;
 i: integer;
 info: PTypeInfo;
 propList: PPropList;
 propInfo: PPropInfo;
 propName: string;
 value: variant;
begin
 info := AObj.ClassInfo;
 data := GetTypeData(info);
 GetMem(propList, data^.PropCount * SizeOf(PPropInfo));
 try
 count := GetPropList(info, tkAny, propList);
 for i := 0 to count - 1 do
 begin
 propName := propList^[i]^.Name;
 propInfo := GetPropInfo(info, propName);
 if propInfo <> nil then
 begin
 case propInfo^.PropType^.Kind of
 tkClass, tkMethod:
 value := '$' + IntToHex(GetOrdProp(AObj, propInfo), 8);
 tkFloat:
 value := GetFloatProp(AObj, propInfo);
 tkInteger:
 value := GetOrdProp(AObj, propInfo);
 tkString, tkLString, tkWString:
 value := GetStrProp(AObj, propInfo);
 tkEnumeration:
 value := GetEnumProp(AObj, propInfo);
 else
 value := '???';
 end;
 if propInfo.default = longint($80000000) then
 default := 'none'
 else
 default := IntToStr(propInfo.default);
 AValues.Add(Format('%s: %s [default: %s]', [propName, value, default]));
 {$80000000 apparently indicates "no default"}
 end;
 end;
 finally
 FreeMem(propList, data^.PropCount * SizeOf(PPropInfo));
 end;
end;
procedure TFrmMorePropInfo.Button2Click(Sender: TObject);
var
 count: integer;
 data: PTypeData;
 i: integer;
 info: PTypeInfo;
 propList: PPropList;
 propInfo: PPropInfo;
 propName: string;
 propVal: variant;
 tmpS: string;
begin
 info := Button2.ClassInfo;
 data := GetTypeData(info);
 GetMem(propList, data^.PropCount * SizeOf(PPropInfo));
 try
 count := GetPropList(info, tkAny, propList);
 ListBox1.Clear;
 for i := 0 to count - 1 do
 begin
 propName := propList^[i]^.Name;
 propInfo := GetPropInfo(info, propName);
 if propInfo <> nil then
 begin
 case propInfo^.PropType^.Kind of
 tkClass, tkMethod:
 propVal := '$' + IntToHex(GetOrdProp(Button2, propInfo), 8);
 tkFloat:
 propVal := GetFloatProp(Button2, propInfo);
 tkInteger:
 propVal := GetOrdProp(Button2, propInfo);
 tkString, tkLString, tkWString:
 propVal := GetStrProp(Button2, propInfo);
 tkEnumeration:
 propVal := GetEnumProp(Button2, propInfo);
 else
 propVal := '...';
 end;
 tmpS := propVal;
 ListBox1.Items.Add(Format('%s: %s [default: %s]', [propName, tmpS, '$'
 + IntToHex(propInfo.default, 8)]));
 {$80000000 apparently indicates "no default"}
 end;
 end;
 finally
 FreeMem(propList, data^.PropCount * SizeOf(PPropInfo));
 end;
end;
end.
Author: Ralph Friedman
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00268
Как получить иконку чужого окна

=== Как получить иконку чужого окна ===
{
First Start Notepad.exe and run this code:
}
procedure TForm1.Button1Click(Sender: TObject);
var
 hWindow: THandle;
 H: HIcon;
begin
 hWindow := FindWindow('notepad', nil);
 H := CopyIcon(GetClassLong(hWindow, GCL_HICON));
 DrawIcon(Canvas.Handle, 30, 30, H);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02360
Как получить имена установленных почтовых клиентов?

{
 Get names of installed Mail-Clients.
}
uses
 Registry;
function GetInstalledMailClients(AList: TStrings): Boolean;
const
 RegClientsRoot = '\SOFTWARE\Clients';
 RegClientsMail = '\Mail';
 RegClientsOpenCmd = '\shell\open\command';
var
 reg: TRegistry;
begin
 Result := True;
 try
 AList.Clear;
 reg := nil;
 reg := TRegistry.Create;
 try
 with reg do
 begin
 CloseKey;
 RootKey := HKEY_LOCAL_MACHINE;
 if OpenKeyReadOnly(RegClientsroot + RegClientsMail) then
 if HasSubKeys then
 GetKeyNames(AList);
 end;
 finally
 if Assigned(reg) then reg.Free;
 end;
 except
 Result := False;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 GetInstalledMailClients(ListBox1.Items);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03409
Category:Связь
Category:Электронная почта
Как получить имя программы, с которой ассоциировано то или иное расширение

=== Как получить имя программы, с которой ассоциировано то или иное расширение ===
uses
{$IFDEF WIN32}
 Registry; { We will get it from the registry }
{$ELSE}
 IniFiles; { We will get it from the win.ini file }
{$ENDIF}
{$IFNDEF WIN32}
const
 MAX_PATH = 144;
{$ENDIF}
function GetProgramAssociation(Ext: string): string;
var
{$IFDEF WIN32}
 reg: TRegistry;
 s: string;
{$ELSE}
 WinIni: TIniFile;
 WinIniFileName: array[0..MAX_PATH] of char;
 s: string;
{$ENDIF}
begin
{$IFDEF WIN32}
 s := ;
 reg := TRegistry.Create;
 reg.RootKey := HKEY_CLASSES_ROOT;
 if reg.OpenKey('.' + ext + '\shell\open\command', false) <> false then
 begin
 { The open command has been found }
 s := reg.ReadString();
 reg.CloseKey;
 end
 else
 begin
 { perhaps thier is a system file pointer }
 if reg.OpenKey('.' + ext, false) <> false then
 begin
 s := reg.ReadString();
 reg.CloseKey;
 if s <> then
 begin
 { A system file pointer was found }
 if reg.OpenKey(s + '\shell\open\command', false) <> false then
 { The open command has been found }
 s := reg.ReadString();
 reg.CloseKey;
 end;
 end;
 end;
 { Delete any command line, quotes and spaces }
 if Pos('%', s) > 0 then
 Delete(s, Pos('%', s), Length(s));
 if ((Length(s) > 0) and
 (s[1] = '"')) then
 Delete(s, 1, 1);
 if ((Length(s) > 0) and
 (s[Length(s)] = '"')) then
 Delete(s, Length(s), 1);
 while ((Length(s) > 0)
 and ((s[Length(s)] = #32) or (s[Length(s)] = '"'))) do
 Delete(s, Length(s), 1);
{$ELSE}
 GetWindowsDirectory(WinIniFileName, SizeOf(WinIniFileName));
 StrCat(WinIniFileName, '\win.ini');
 WinIni := TIniFile.Create(WinIniFileName);
 s := WinIni.ReadString('Extensions', ext, );
 WinIni.Free;
 { Delete any command line }
 if Pos(' ^', s) > 0 then
 Delete(s, Pos(' ^', s), Length(s));
{$ENDIF}
 Result := s;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetProgramAssociation('gif'));
end;
Author: Олег Кулабухов
ID: 01741
Как получить имя текущего пользователя?

function GetCurrentUser: string;
var
 pwrec: PPasswordRecord;
begin
 pwrec := getpwuid(getuid);
 Result := pwrec.pw_name;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04592
Category:Kylix
Category:Linux
Как получить имя текущего стиля и имя цветовой схемы?

=== Как получить имя текщего стиля и имя цветовой схемы? ===
uses ComObj, SyncObjs;
var
 GetCurrentThemeName: function (pszThemeFileName: LPWSTR; cchMaxNameChars: Integer;
 pszColorBuff: LPWSTR; cchMaxColorChars: Integer; pszSizeBuff: LPWSTR;
 cchMaxSizeChars: Integer): HRESULT; stdcall;
procedure TForm1.Button1Click(Sender: TObject);
var
 FileName, ColorScheme, SizeName: WideString;
 hThemeLib: THandle;
begin
 try
 hThemeLib := LoadLibrary('uxtheme.dll');
 if hThemeLib > 0 then
 GetCurrentThemeName := GetProcAddress(hThemeLib, 'GetCurrentThemeName');
 if Assigned(GetCurrentThemeName) then
 begin
 SetLength(FileName, 255);
 SetLength(ColorScheme, 255);
 SetLength(SizeName, 255);
 OleCheck(GetCurrentThemeName(PWideChar(FileName), 255,
 PWideChar(ColorScheme), 255, PWideChar(SizeName), 255));
 // show the the theme path and file name.
 ShowMessage(PWideChar(FileName));
 // show the color scheme name
 ShowMessage(PWideChar(ColorScheme));
 // show the size name
 ShowMessage(PWideChar(SizeName));
 end;
 finally
 FreeLibrary(hThemeLib);
 end;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00400
Как получить информацию о BIOS в Windows 9x?

=== Как получить информацию о BIOS в Windows 9x? ===
with Memo1.Lines do 
begin 
 Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061)))); 
 Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091)))); 
 Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5)))); 
 Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71)))); 
end;
Source: Взято из http://forum.sources.ru
ID: 01361
Как получить информацию о BIOS в Windows NT/2000/XP?

=== Как получить информацию о BIOS в Windows NT/2000/XP? ===
В NT/2000/XP не получится прочитать значения прямо из BIOS, однако, ничего не мешает нам считать нужные значения из реестра.
procedure TBIOSInfo.GetRegInfoWinNT;
var
 RegistryV: TRegistry;
 RegPath: string;
 sl: TStrings;
begin
 Params.Clear;
 RegPath := '\HARDWARE\DESCRIPTION\System';
 RegistryV := TRegistry.Create;
 RegistryV.RootKey := HKEY_LOCAL_MACHINE;
 sl := nil;
 try
 RegistryV.Openkey(RegPath, False);
 ShowMessage('BIOS Date: ' + RegistryV.ReadString('SystemBiosDate'));
 sl := ReadMultirowKey(RegistryV, 'SystemBiosVersion');
 ShowMessage('BIOS Version: ' + sl.Text);
 except
 end;
 RegistryV.Free;
 if Assigned(sl) then sl.Free;
end;
ID: 01362
----
// следующий метод получает многострочные значения из реестра
// и преобразует их в TStringlist
function ReadMultirowKey(reg: TRegistry; Key: string): TStrings; 
const
 bufsize = 100; 
var 
 i: integer; 
 s1: string; 
 sl: TStringList; 
 bin: array[1..bufsize] of char; 
begin 
 try 
 result := nil; 
 sl := nil; 
 sl := TStringList.Create; 
 if not Assigned(reg) then 
 raise Exception.Create('TRegistry object not assigned.'); 
 FillChar(bin, bufsize, #0); 
 reg.ReadBinaryData(Key, bin, bufsize); 
 i := 1; 
 s1 := ; 
 while i < bufsize do 
 begin 
 if ord(bin[i]) >= 32 then 
 s1 := s1 + bin[i] 
 else 
 begin 
 if Length(s1) > 0 then 
 begin 
 sl.Add(s1); 
 s1 := ; 
 end; 
 end; 
 inc(i); 
 end; 
 result := sl; 
 except 
 sl.Free; 
 raise; 
 end; 
end;
Source: Взято из http://forum.sources.ru
ID: 01363
Как получить информацию о системе?

=== Как получить информацию о системе? ===
{
 The SYSTEM_INFO structure contains information about the current computer
 system. This includes the architecture and type of the processor, the number of
 processors in the system, the page size, and other such information.
}
procedure TForm1.Button1Click(Sender: TObject);
var
 SysInfo: TSystemInfo;
begin
 GetSystemInfo(SysInfo);
 with ListBox1.Items, SysInfo do
 begin
 Add('ProcessorArchitecture:' + IntToStr(wProcessorArchitecture));
 Add(FloatToStr(dwPageSize) + ' Kb page size');
 Add(Format('Lowest memory address accessible to applications and DLL - %p',
 [lpMinimumApplicationAddress]));
 Add(Format('Highest memory address accessible to applications and DLL - %p',
 [lpMaximumApplicationAddress]));
 Add('OEMID:' + IntToStr(dwOemId));
 Add('ActiveProcessorMask:' + IntToStr(dwActiveProcessorMask));
 Add(IntToStr(dwNumberOfProcessors) + ' - number of processors');
 Add('ProcessorType:' + IntToStr(dwProcessorType));
 case wProcessorLevel of
 3: Add('Intel 80386 processor level');
 4: Add('Intel 80486 processor level');
 5: Add('Intel Pentium processor level');
 end;
 Add(FloatToStr(dwAllocationGranularity / 1024) +
 ' Kb - granularity with which virtual memory is allocated');
 Add('ProcessorRevision:' + IntToStr(wProcessorRevision));
 end;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01331
Как получить картинки из MessageDlg?

=== Как получить картинки из MessageDlg? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 Ic: TIcon;
begin
 Ic := TIcon.Create;
 Ic.Handle := LoadIcon(0, IDI_APPLICATION);
 Form1.Canvas.Draw(1, 1, Ic);
 Ic.Handle := LoadIcon(0, IDI_ASTERISK);
 Form1.Canvas.Draw(32, 1, Ic);
 Ic.Handle := LoadIcon(0, IDI_EXCLAMATION);
 Form1.Canvas.Draw(64, 1, Ic);
 Ic.Handle := LoadIcon(0, IDI_QUESTION);
 Form1.Canvas.Draw(1, 32, Ic);
 Ic.Handle := LoadIcon(0, IDI_HAND);
 Form1.Canvas.Draw(32, 32, Ic);
 Ic.Handle := LoadIcon(0, IDI_WINLOGO);
 Form1.Canvas.Draw(64, 32, Ic);
 Ic.Destroy;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01204
Как получить количество активных ссылок на строку?

=== Как получить количество активных ссылок на строку? ===
function GetAnsistringRefcount(const S: string): Cardinal;
asm
 or eax, eax
 jz @done
 sub eax, 8
 mov eax, dword ptr [eax]
 @done:
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 S1, S2: string;
begin
 memo1.lines.Add(Format('Refcount at start: %d',
 [GetAnsistringRefcount(S1)]));
 S1 := StringOfChar('A', 10);
 memo1.lines.Add(Format('Refcount after assignment: %d',
 [GetAnsistringRefcount(S1)]));
 S2 := S1;
 memo1.lines.Add(Format('Refcount after S2:=S1: %d',
 [GetAnsistringRefcount(S1)]));
 S2 := S1 + S2;
 memo1.lines.Add(Format('Refcount after S2:=S1+S2: %d',
 [GetAnsistringRefcount(S1)]));
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00161
Как получить количество файлов в корзине и их размер?

=== Как получить количество файлов в корзине и их размер? ===
type
 PSHQueryRBInfo = ^TSHQueryRBInfo;
 TSHQueryRBInfo = packed record
 cbSize: DWORD;
 // Size of the structure, in bytes.
 // This member must be filled in prior to calling the function.
 i64Size: Int64;
 // Total size of all the objects in the specified Recycle Bin, in bytes.
 i64NumItems: Int64;
 // Total number of items in the specified Recycle Bin.
 end;
const
 shell32 = 'shell32.dll';
function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;
 stdcall; external shell32 Name 'SHQueryRecycleBinA';
function GetDllVersion(FileName: string): Integer;
var
 InfoSize, Wnd: DWORD;
 VerBuf: Pointer;
 FI: PVSFixedFileInfo;
 VerSize: DWORD;
begin
 Result := 0;
 InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
 if InfoSize <> 0 then
 begin
 GetMem(VerBuf, InfoSize);
 try
 if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
 if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
 Result := FI.dwFileVersionMS;
 finally
 FreeMem(VerBuf);
 end;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 DllVersion: integer;
 SHQueryRBInfo: TSHQueryRBInfo;
 r: HResult;
begin
 DllVersion := GetDllVersion(PChar(shell32));
 if DllVersion >= $00040048 then
 begin
 FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);
 SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);
 R := SHQueryRecycleBin(nil, @SHQueryRBInfo);
 if r = s_OK then
 begin
 label1.Caption := Format('Size:%d Items:%d',
 [SHQueryRBInfo.i64Size, SHQueryRBInfo.i64NumItems]);
 end
 else
 label1.Caption := Format('Err:%x', [r]);
 end;
end;
{
The SHQueryRecycleBin API used in this method is
only available on systems with the latest shell32.dll installed with IE4 /
Active Desktop.
}
ID: 01708