nyuuzyou/wikis huggingface dataset:
Как узнать имя домена Windows NT/2000?

function GetNTDomainName: string;
var
 hReg: TRegistry;
begin
 hReg := TRegistry.Create;
 hReg.RootKey := HKEY_LOCAL_MACHINE;
 hReg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon', False);
 Result := hReg.ReadString('DefaultDomainName');
 hReg.CloseKey;
 hReg.Destroy;
end;
Source: Взято из http://forum.sources.ru
ID: 03296
----
function NetServerGetInfo (serverName : PWideChar; level : Integer;
 var bufptr : Pointer) : Cardinal; stdcall; external 'NETAPI32.DLL';
function NetApiBufferFree (buffer : Pointer) : Cardinal; stdcall; external 'NETAPI32.DLL';
type
 SERVER_INFO_503 = record
 sv503_sessopens : Integer;
 sv503_sessvcs : Integer;
 sv503_opensearch : Integer;
 sv503_sizreqbuf : Integer;
 sv503_initworkitems : Integer;
 sv503_maxworkitems : Integer;
 sv503_rawworkitems : Integer;
 sv503_irpstacksize : Integer;
 sv503_maxrawbuflen : Integer;
 sv503_sessusers : Integer;
 sv503_sessconns : Integer;
 sv503_maxpagedmemoryusage : Integer;
 sv503_maxnonpagedmemoryusage : Integer;
 sv503_enablesoftcompat :BOOL;
 sv503_enableforcedlogoff :BOOL;
 sv503_timesource :BOOL;
 sv503_acceptdownlevelapis :BOOL;
 sv503_lmannounce :BOOL;
 sv503_domain : PWideChar;
 sv503_maxcopyreadlen : Integer;
 sv503_maxcopywritelen : Integer;
 sv503_minkeepsearch : Integer;
 sv503_maxkeepsearch : Integer;
 sv503_minkeepcomplsearch : Integer;
 sv503_maxkeepcomplsearch : Integer;
 sv503_threadcountadd : Integer;
 sv503_numblockthreads : Integer;
 sv503_scavtimeout : Integer;
 sv503_minrcvqueue : Integer;
 sv503_minfreeworkitems : Integer;
 sv503_xactmemsize : Integer;
 sv503_threadpriority : Integer;
 sv503_maxmpxct : Integer;
 sv503_oplockbreakwait : Integer;
 sv503_oplockbreakresponsewait : Integer;
 sv503_enableoplocks : BOOL;
 sv503_enableoplockforceclose : BOOL;
 sv503_enablefcbopens : BOOL;
 sv503_enableraw : BOOL;
 sv503_enablesharednetdrives : BOOL;
 sv503_minfreeconnections : Integer;
 sv503_maxfreeconnections : Integer;
 end;
 PSERVER_INFO_503 = ^SERVER_INFO_503;
function Get_Computer_Name: string;
var
 dwlen: DWORD;
begin
 dwlen := MAX_COMPUTERNAME_LENGTH + 1;
 SetLength(Result, dwlen);
 GetComputerName(PChar(Result), dwlen);
 Result := StrPas(PChar(Result));
end;
function GetDomainName: string;
var
 err: Integer;
 buf: Pointer;
 wServerName: WideString;
begin
 Result := ;
 wServerName := Get_Computer_Name;
 err := NetServerGetInfo(PWideChar(wServerName), 503, buf);
 if err = 0 then
 try
 Result := PSERVER_INFO_503(buf)^.sv503_domain;
 finally
 NetAPIBufferFree(buf);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption := GetDomainName;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03297
Category:Связь
Как узнать имя компьютера?

=== Как узнать имя компьютера? ===
function ReadComputerName(): string;
var
 i: DWORD; 
 p: PChar;
begin
 i := 255;
 GetMem(p, i);
 GetComputerName(p, i);
 Result := String(p);
 FreeMem(p);
end;
Author: Vit
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01715
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение локального имени компьютера
Зависимости: Winsock
Copyright: Gua
Дата: 23 июля 2002 г.
***************************************************** }
function GetLocalName: string;
var
 WSAData: TWSAData;
 Namebuf: array[0..255] of char;
begin
 WSAStartup($101, WSAData);
 GetHostname(namebuf, sizeof(namebuf));
 Result := NameBuf;
 WSACleanup;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01716
----
Чтобы узнать имя, идентифицирующее компьютер в сети, на котором запущена Ваша программа, можно воспользоваться следующей функцией:
 
uses Windows;
function GetComputerNetName: string;
var
 buffer: array[0..255] of char;
 size: dword;
begin
 size := 256;
 if GetComputerName(buffer, size) then
 Result := buffer
 else
 Result := ''
end;
 
Source: Взято из http://forum.sources.ru
ID: 03298
----
Вариант для Linux
uses Libc;
function GetPCName: string;
var
 Name: PChar;
 Len: Cardinal;
begin
 Len := 255;
 GetMem(Name, Len);
 try
 GetHostName(Name, Len);
 Result := String(Name);
 finally
 FreeMem(Name);
 end;
end;
Author: Vit
ID: 04628
Category:Связь
Как узнать имя пользователя

=== Как узнать имя пользователя ===
function GetUserFromWindows: string;
var
 UserName : string;
 UserNameLen : Dword;
begin
 UserNameLen := 255;
 SetLength(userName, UserNameLen);
 if GetUserName(PChar(UserName), UserNameLen) then
 Result := Copy(UserName,1,UserNameLen - 1)
 else
 Result := ;
end;
ID: 01730
----
function GetCurrentUserName: string;
const
 cnMaxUserNameLen = 254;
var
 sUserName: string;
 dwUserNameLen: DWORD;
begin
 dwUserNameLen := cnMaxUserNameLen - 1;
 SetLength(sUserName, cnMaxUserNameLen);
 GetUserName(PChar(sUserName), dwUserNameLen);
 SetLength(sUserName, dwUserNameLen);
 Result := sUserName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetCurrentUserName);
end;
Source: http://delphiworld.narod.ru/
ID: 01731
----
function GetCurrentUserName(var CurrentUserName: string): Boolean;
var
 BufferSize: DWORD;
 pUser: PChar;
begin
 BufferSize := 0;
 GetUserName(nil, BufferSize);
 pUser := StrAlloc(BufferSize);
 try
 Result := GetUserName(pUser, BufferSize);
 CurrentUserName := StrPas(pUser);
 finally
 StrDispose(pUser);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 CurrentUserName: string;
begin
 GetCurrentUserName(CurrentUserName);
 Label1.Caption := CurrentUserName;
end;
{*********************************************}
{
 Windows NT/2000/XP:
 The GetUserNameEx function retrieves the name of the user or other
 security principal associated with the calling thread.
 You can specify the format of the returned name.
 If the thread is impersonating a client, GetUserNameEx
 returns the name of the client.
}
const
 NameUnknown = 0; // Unknown name type.
 NameFullyQualifiedDN = 1; // Fully qualified distinguished name
 NameSamCompatible = 2; // Windows NT® 4.0 account name
 NameDisplay = 3; // A "friendly" display name
 NameUniqueId = 6; // GUID string that the IIDFromString function returns
 NameCanonical = 7; // Complete canonical name
 NameUserPrincipal = 8; // User principal name
 NameCanonicalEx = 9;
 NameServicePrincipal = 10; // Generalized service principal name
 DNSDomainName = 11; // DNS domain name, plus the user name
procedure GetUserNameEx(NameFormat: DWORD;
 lpNameBuffer: LPSTR; nSize: PULONG); stdcall;
 external 'secur32.dll' Name 'GetUserNameExA';
function LoggedOnUserNameEx(fFormat: DWORD): string;
var
 UserName: array[0..250] of char;
 Size: DWORD;
begin
 Size := 250;
 GetUserNameEx(fFormat, @UserName, @Size);
 Result := UserName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Edit1.Text := LoggedOnUserNameEx(NameSamCompatible);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01732
Как узнать имя пользователя?

function GetUserFromWindows: string;
var
 UserName: string;
 UserNameLen: Dword;
begin
 UserNameLen := 255;
 SetLength(userName, UserNameLen);
 if GetUserName(PChar(UserName), UserNameLen) then
 Result := Copy(UserName, 1, UserNameLen - 1)
 else
 Result := ;
end;
ID: 01730
----
function GetCurrentUserName: string;
const
 cnMaxUserNameLen = 254;
var
 sUserName: string;
 dwUserNameLen: DWORD;
begin
 dwUserNameLen := cnMaxUserNameLen - 1;
 SetLength(sUserName, cnMaxUserNameLen);
 GetUserName(PChar(sUserName), dwUserNameLen);
 SetLength(sUserName, dwUserNameLen);
 Result := sUserName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetCurrentUserName);
end;
Source: http://delphiworld.narod.ru/
ID: 01731
----
function GetCurrentUserName(var CurrentUserName: string): Boolean;
var
 BufferSize: DWORD;
 pUser: PChar;
begin
 BufferSize := 0;
 GetUserName(nil, BufferSize);
 pUser := StrAlloc(BufferSize);
 try
 Result := GetUserName(pUser, BufferSize);
 CurrentUserName := StrPas(pUser);
 finally
 StrDispose(pUser);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 CurrentUserName: string;
begin
 GetCurrentUserName(CurrentUserName);
 Label1.Caption := CurrentUserName;
end;
{*********************************************}
{
 Windows NT/2000/XP:
 The GetUserNameEx function retrieves the name of the user or other
 security principal associated with the calling thread.
 You can specify the format of the returned name.
 If the thread is impersonating a client, GetUserNameEx
 returns the name of the client.
}
const
 NameUnknown = 0; // Unknown name type.
 NameFullyQualifiedDN = 1; // Fully qualified distinguished name
 NameSamCompatible = 2; // Windows NT® 4.0 account name
 NameDisplay = 3; // A "friendly" display name
 NameUniqueId = 6; // GUID string that the IIDFromString function returns
 NameCanonical = 7; // Complete canonical name
 NameUserPrincipal = 8; // User principal name
 NameCanonicalEx = 9;
 NameServicePrincipal = 10; // Generalized service principal name
 DNSDomainName = 11; // DNS domain name, plus the user name
procedure GetUserNameEx(NameFormat: DWORD; lpNameBuffer: LPSTR; nSize: PULONG); stdcall;
 external 'secur32.dll' Name 'GetUserNameExA';
function LoggedOnUserNameEx(fFormat: DWORD): string;
var
 UserName: array[0..250] of char;
 Size: DWORD;
begin
 Size := 250;
 GetUserNameEx(fFormat, @UserName, @Size);
 Result := UserName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Edit1.Text := LoggedOnUserNameEx(NameSamCompatible);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01732
Category:Связь
Как узнать имя файла текущего процесса?

=== Как узнать имя файла текущего процесса? ===
Для этого существует функция GetModuleFileName, которая возвращает имя файла текущего процесса.
function GetModName: String;
var
 fName: string;
 nsize: Cardinal;
begin
 nsize := 128;
 SetLength(fName, nsize);
 SetLength(fName,
 GetModuleFileName(
 hinstance,
 pchar(fName),
 nsize));
 Result := fName;
end;
Source: Взято из http://forum.sources.ru
ID: 02053
Как узнать какое окно закрывает форму

=== Как узнать какое окно закрывает форму ===
// Find windows that may cover another window.
var
 hW: HWnd;
 r: TRect;
begin
 hw := Handle;
 while IsWindow(hw) do
 begin
 hw := GetWindow(hw, GW_HWNDPREV);
 if IsWindowVisible(hw) and not IsIconic(hw) then
 begin
 //... use GetWindowRect( hw, r ) to get candidate windows
 // rect and check if it intersects the forms BoundsRects via
 // IntersectRect
 end;
 end;
end;
ID: 00513
Как узнать количество CD в системе?

=== Как узнать количество CD в системе? ===
function GetNumberOfCDDrives: Byte;
var
 drivemap, mask: DWORD;
 i: integer;
 root: string;
begin
 Result := 0;
 root := 'A:\';
 drivemap := GetLogicalDrives;
 mask := 1;
 for i := 1 to 32 do
 begin
 if (mask and drivemap) <> 0 then
 if GetDriveType(PChar(root)) = DRIVE_CDROM then
 begin
 Inc(Result);
 end;
 mask := mask shl 1;
 Inc(root[1]);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption := IntToStr(GetNumCDDrives);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01414
Как узнать количество видимых строчек в TMemo?

=== Как узнать количество видимых строчек в TMemo? ===
function LinesVisible(Memo: TMemo): integer; 
var 
 OldFont: HFont; 
 Hand: THandle; 
 TM: TTextMetric; 
 Rect: TRect; 
 tempint: integer; 
begin 
 Hand := GetDC(Memo.Handle); 
 try 
 OldFont := SelectObject(Hand, Memo.Font.Handle); 
 try 
 GetTextMetrics(Hand, TM); 
 Memo.Perform(EM_GETRECT, 0, longint(@Rect)); 
 tempint := (Rect.Bottom - Rect.Top) div (TM.tmHeight + TM.tmExternalLeading); 
 finally 
 SelectObject(Hand, OldFont); 
 end; 
 finally 
 ReleaseDC(Memo.Handle, Hand); 
 end; 
 Result := tempint; 
end; 
Source: Взято из http://forum.sources.ru
ID: 00556
Как узнать количество памяти используемое процессом?

=== Как узнать количество памяти используемое процессом? ===
// Works only on Windows NT systems (WinNT, Win2000, WinXP)
uses psAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
 pmc: PPROCESS_MEMORY_COUNTERS;
 cb: Integer;
begin
 cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
 GetMem(pmc, cb);
 pmc^.cb := cb;
 if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
 Label1.Caption := IntToStr(pmc^.WorkingSetSize) + ' Bytes'
 else
 Label1.Caption := 'Unable to retrieve memory usage structure';
 FreeMem(pmc);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02056
Как узнать количество цветов в системной палитре?

=== Как узнать количество цветов в системной палитре? ===
function GetNumColors: LongInt;
var
 BPP: Integer;
 DC: HDC;
begin
 DC := CreateDC('DISPLAY', nil, nil, nil);
 if DC <> 0 then
 begin
 try
 BPP := GetDeviceCaps(DC, BITPIXEL) * GetDeviceCaps(DC, PLANES);
 finally
 DeleteDC(DC);
 end;
 case BPP of
 1: Result := 2;
 4: Result := 16;
 8: Result := 256;
 15: Result := 32768;
 16: Result := 65536;
 24: Result := 16777216;
 end;
 end
 else
 Result := 0;
end;
ID: 01457
Как узнать конфигурацию железа?

=== Как узнать конфигурацию железа? ===
Вот компонент для этого нашел:
 http://delphi.mastak.ru/cgi-bin/download.pl?get=1020812496&n=0
описание от авторов:
 File: msi.zip
 Product: MiTeC System Information Component
 Version: 6.2
 E-Mail: michal.mutl@atlas.cz
 Target: Delphi 5.x, Delphi 6.x
 Platform: W95, W98, NT, W2000, Windows ME, Windows XP
 Status: Fully Functional
 Source: Included
 Description: Component providing detailed system information
 + Registered organization, owner
 + Time Zone info
 + Machine name, IP address, MAC Address
 + Last boot date and time, Boot time
 + CPU architecture, type, active mask, count, level, revision, vendor, id, speed,
 + OS version, build number, platform, CSD version, version name, user name, serial number
 + DVD Region, folders
 + Graphic adapter chip name, dac, memory, screen width and height, color depth, modes
 + Sound card name, WaveIn, WaveOut, MIDIIn, MIDIOut, AUX, Mixer device name
 + Printers
 + Memory info, allocation granularity, min.and max.application address
 + Disk info, file system, controllers
 + BIOS name, copyright, extended info, date
 + Video BIOS version and date
 + Network adapter, protocols, sevices, clients,
 + Winsock info
 + BDE, ODBC, DAO, ADO version
 + DirectX info
 + Device overview (like Device Manager)
 + Win9x resources
 + Running process enumeration
 + Installed software enumeration
 + Startup runs enumeration
 + Performance Library interface (NT & 9x)
 + Internet settings
 + Sharepoints enumeration
 + Component showing CPU usage
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01328
----
Почти все о железе можно прочитать из регистра по HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\ 
Author: Diamond cat
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01329
Как узнать минимальные поля для принтера?

uses
 Printers;
type
 TMargins = record
 Left,
 Top,
 Right,
 Bottom: Double
 end;
procedure GetPrinterMargins(var Margins: TMargins);
var
 PixelsPerInch: TPoint;
 PhysPageSize: TPoint;
 OffsetStart: TPoint;
 PageRes: TPoint;
begin
 PixelsPerInch.y := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
 PixelsPerInch.x := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
 Escape(Printer.Handle, GETPHYSPAGESIZE, 0, nil, @PhysPageSize);
 Escape(Printer.Handle, GETPRINTINGOFFSET, 0, nil, @OffsetStart);
 PageRes.y := GetDeviceCaps(Printer.Handle, VERTRES);
 PageRes.x := GetDeviceCaps(Printer.Handle, HORZRES);
 // Top Margin
 Margins.Top := OffsetStart.y / PixelsPerInch.y;
 // Left Margin
 Margins.Left := OffsetStart.x / PixelsPerInch.x;
 // Bottom Margin
 Margins.Bottom := ((PhysPageSize.y - PageRes.y) / PixelsPerInch.y) -
 (OffsetStart.y / PixelsPerInch.y);
 // Right Margin
 Margins.Right := ((PhysPageSize.x - PageRes.x) / PixelsPerInch.x) -
 (OffsetStart.x / PixelsPerInch.x);
end;
// Convert inch to Centimeter
function InchToCm(Pixel: Single): Single;
begin
 Result := Pixel * 2.54
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 Margins: TMargins;
begin
 GetPrinterMargins(Margins);
 ShowMessage(Format('Margins: (Left: %1.3f, Top: %1.3f, Right: %1.3f, Bottom: %1.3f)',
 [InchToCm(Margins.Left),
 InchToCm(Margins.Top),
 InchToCm(Margins.Right),
 InchToCm(Margins.Bottom)]));
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03200
Category:Принтер
Как узнать номер BIOS для разных версий Windows?

=== Как узнать номер BIOS для разных версий Windows? ===
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;
Windows NT
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;
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;
нашел на http://www.sources.ru/delphi/system/get_bios_information_w9x.shtml
и http://www.sources.ru/delphi/system/get_bios_information_nt_2000_xp.shtml
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01355
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение серийного номера BIOS
Зависимости:
Copyright:
Дата: 03 мая 2002 г.
***************************************************** }
function GetBiosNumber: string;
begin
 Result := string(PChar(Ptr($FEC71)));
end;
Source: http://delphibase.endimus.com
ID: 01356
Как узнать номер автоинкремента при вставке новой записи?

=== Как узнать номер автоинкремента при вставке новой записи? ===
We have a table in MsAccess like :
Test, Fields (id=autoinc, name=text);
First we have to have a function like the one below :
function GetLastInsertID: integer;
begin
 // datResult = TADODataSet
 datResult.Active := False;
 datResult.CommandText := 'select @@IDENTITY as [ID]';
 datResult.Active := True;
 Result := datResult.FieldByName('id').AsInteger;
 datResult.Active := False;
end;
Now before getting the last inserted record record id = autoincrement field, in other words calling the above function. You have to do a SQL insert like the following
procedure InsertRec;
begin
 // datCommand = TADOCommand
 datCommand.CommandText := 'insert into [test] ( [name] ) values ( "Test" )';
 datCommand.Execute;
end;
Now if we like to know which is the last autoinc value ( notice that the getlastinsertid proc. only works after the insertrec proc)
procedure Test;
begin
 InsertRec;
 Showmessage(format('lastinsertid : %d', [GetLastInsertID]));
end;
Hope you can make this work, it works for me, any questions feel free to ask
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02764
Как узнать номер недели данного дня в году?

=== Как узнать номер недели данного дня в году? ===
Вариант 1:
function WeekOfYear(ADate : TDateTime) : word;
var
 day : word;
 month : word;
 year : word;
 FirstOfYear : TDateTime;
begin
 DecodeDate(ADate, year, month, day);
 FirstOfYear := EncodeDate(year, 1, 1);
 Result := Trunc(ADate - FirstOfYear) div 7 + 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(IntToStr(WeekOfYear(Date)));
end;
ID: 00179
----
Вариант 2:
function WeekNum(const ADate: TDateTime): word;
var
 Year: word;
 Month: word;
 Day: word;
begin
 DecodeDate(ADate + 4 - DayOfWeek(ADate + 6), Year, Month, Day);
 result := 1 + trunc((ADate - EncodeDate(Year, 1, 5) +
 DayOfWeek(EncodeDate(Year, 1, 3))) / 7);
end;
ID: 00180
----
Вариант 3:
function WeekOfYear(Dat: TDateTime): Word;
// Интерпретация номеров дней:
// ISO: 1 = Понедельник, 7 = Воскресенье
// Delphi SysUtils: 1 = Воскресенье, 7 = Суббота
var
 Day,
 Month,
 Year: Word;
 FirstDate: TDateTime;
 DateDiff : Integer;
begin
 day := SysUtils.DayOfWeek(Dat)-1;
 Dat := Dat + 3 - ((6 + day) mod 7);
 DecodeDate(Dat, Year, Month, Day);
 FirstDate := EncodeDate(Year, 1, 1);
 DateDiff := Trunc(Dat - FirstDate);
 Result := 1 + (DateDiff div 7);
end;
Получить номер недели по дате 
var
 FirstWeekDay: Integer = 2;
 { Wochentag, mit dem die Woche beginnt 
 (siehe Delphi-Wochentage) 
 2 : Montag (nach DIN 1355) }
 FirstWeekDate: Integer = 4;
 { 1 : Beginnt am ersten Januar 
 4 : Erste-4 Tage-Woche (nach DIN 1355) 
 7 : Erste volle Woche }
 { liefert das Datum des ersten Tages der Woche }
 { get date of first day of week}
 function WeekToDate(AWeek, AYear: Integer): TDateTime;
 begin
 Result := EncodeDate(AYear, 1, FirstWeekDate);
 Result := Result + (AWeek - 1) * 7 - ((DayOfWeek(Result) + (7 - FirstWeekDay)) mod 7);
 end;
 { liefert die Wochennummer und das Jahr, zu dem die Woche gehort }
 { get weeknumber and year of the given week number}
 procedure DateToWeek(ADate: TDateTime; var AWeek, AYear: Word);
 var
 Month, Day: Word;
 begin
 ADate := ADate - ((DayOfWeek(ADate) - FirstWeekDay + 7) mod 7) + 7 - FirstWeekDate;
 DecodeDate(ADate, AYear, Month, Day);
 AWeek := (Trunc(ADate - EncodeDate(AYear, 1, 1)) div 7) + 1;
 end;
 { Week to date example }
 procedure TForm1.Button1Click(Sender: TObject);
 begin
 ShowMessage(FormatDateTime('dd.mm.yyyy', WeekToDate(51, 2000)));
 end;
 { Date to week example }
 procedure TForm1.Button2Click(Sender: TObject);
 var
 week, year: Word;
 begin
 DateToWeek(now, week, year);
 ShowMessage(IntToStr(week));
 ShowMessage(IntToStr(year));
 end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00751
Как узнать о нажатии NON-MENU клавиши в момент когда меню показано

=== Как узнать о нажатии NON-MENU клавиши в момент когда меню показано ===
Создайте обработчик сообщения WM_MENUCHAR. 
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls,
 Forms, Dialogs, Menus;
type
 TForm1 = class(TForm)
 MainMenu1: TMainMenu;
 One1: TMenuItem;
 Two1: TMenuItem;
 THree1: TMenuItem;
 private
 { Private declarations }
 procedure WmMenuChar(var m : TMessage); message WM_MENUCHAR;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WmMenuChar(var m: TMessage);
begin
 Form1.Caption := 'Non standard menu key pressed';
 m.Result := 1;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01559
Как узнать о нажатии non-menu клавиши в момент когда меню показано?

=== Как узнать о нажатии non-menu клавиши в момент когда меню показано? ===
Создайте обработчик сообщения WM_MENUCHAR.
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus;
type 
 TForm1 = class(TForm)
 MainMenu1: TMainMenu;
 One1: TMenuItem;
 Two1: TMenuItem;
 THree1: TMenuItem;
 private
 { Private declarations }
 procedure WmMenuChar(var m : TMessage); message WM_MENUCHAR;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WmMenuChar(var m : TMessage);
begin
 Form1.Caption := 'Non standard menu key pressed';
 m.Result := 1;
end;
end.
Source: Взято из http://forum.sources.ru
ID: 01302
Как узнать откуда была установленна Windows?

=== Как узнать откуда была установлена Windows? ===
Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других - Windows был установлен с CD. Как узнать откуда была установлена Windows? 
Эту информацию можно получить из реестра.
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
 reg: TRegistry;
begin
 reg := TRegistry.Create;
 reg.RootKey := HKEY_LOCAL_MACHINE;
 reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP', False);
 ShowMessage(reg.ReadString('SourcePath'));
 reg.CloseKey;
 reg.Free;
end;
ID: 01665