nyuuzyou/wikis huggingface dataset:
Как проверить запущен ли сервис?

=== Как проверить запущен ли сервис? ===
uses
 WinSvc;
function ServiceGetStatus(sMachine, sService: PChar): DWORD;
 {******************************************}
 {*** Parameters: ***}
 {*** sService: specifies the name of the service to open
 {*** sMachine: specifies the name of the target computer
 {*** ***}
 {*** Return Values: ***}
 {*** -1 = Error opening service ***}
 {*** 1 = SERVICE_STOPPED ***}
 {*** 2 = SERVICE_START_PENDING ***}
 {*** 3 = SERVICE_STOP_PENDING ***}
 {*** 4 = SERVICE_RUNNING ***}
 {*** 5 = SERVICE_CONTINUE_PENDING ***}
 {*** 6 = SERVICE_PAUSE_PENDING ***}
 {*** 7 = SERVICE_PAUSED ***}
 {******************************************}
var
 SCManHandle, SvcHandle: SC_Handle;
 SS: TServiceStatus;
 dwStat: DWORD;
begin
 dwStat := 0;
 // Open service manager handle.
 SCManHandle := OpenSCManager(sMachine, nil, SC_MANAGER_CONNECT);
 if (SCManHandle > 0) then
 begin
 SvcHandle := OpenService(SCManHandle, sService, SERVICE_QUERY_STATUS);
 // if Service installed
 if (SvcHandle > 0) then
 begin
 // SS structure holds the service status (TServiceStatus);
 if (QueryServiceStatus(SvcHandle, SS)) then
 dwStat := ss.dwCurrentState;
 CloseServiceHandle(SvcHandle);
 end;
 CloseServiceHandle(SCManHandle);
 end;
 Result := dwStat;
end;
function ServiceRunning(sMachine, sService: PChar): Boolean;
begin
 Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService);
end;
// Check if Eventlog Service is running
procedure TForm1.Button1Click(Sender: TObject);
begin
 if ServiceRunning(nil, 'Eventlog') then
 ShowMessage('Eventlog Service Running')
 else
 ShowMessage('Eventlog Service not Running')
end;
{
 Windows 2000 and earlier: All processes are granted the SC_MANAGER_CONNECT,
 SC_MANAGER_ENUMERATE_SERVICE, and SC_MANAGER_QUERY_LOCK_STATUS access rights.
 Windows XP: Only authenticated users are granted the SC_MANAGER_CONNECT,
 SC_MANAGER_ENUMERATE_SERVICE,
 and SC_MANAGER_QUERY_LOCK_STATUS access rights.
}
{
 Do not use the service display name (as displayed in the services
 control panel applet.) You must use the real service name, as
 referenced in the registry under
 HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services
}
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02233
Как проверить инсталлирован ли MS Word?

uses
 ..., Registry;
function IsMicrosoftWordInstalled: Boolean;
var
 Reg: TRegistry;
 S: string;
begin
 Reg := TRegistry.Create;
 with Reg do
 begin
 RootKey := HKEY_CLASSES_ROOT;
 Result := KeyExists('Word.Application');
 Free;
 end;
end;
ID: 04417
----
function MSWordIsInstalled: Boolean;
begin
 Result := AppIsInstalled('Word.Application');
end;
function AppIsInstalled(strOLEObject: string): Boolean;
var
 ClassID: TCLSID;
begin
 Result := (CLSIDFromProgID(PWideChar(WideString(strOLEObject)), ClassID) = S_OK)
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04418
----
Как определить установлен ли на компьютере Word, запустить его и загрузить в него текст из программы?
Пример:
var
 MsWord: Variant;
begin
 try
 // Если Word уже запущен
 MsWord := GetActiveOleObject('Word.Application');
 // Взять ссылку на запущенный OLE объект
 except
 try
 // Word не запущен, запустить
 MsWord := CreateOleObject('Word.Application');
 // Создать ссылку на зарегистрированный OLE объект
 MsWord.Visible := True;
 except
 ShowMessage('Не могу запустить Microsoft Word');
 Exit;
 end;
 end;
 MSWord.Documents.Add; // Создать новый документ
 MsWord.Selection.Font.Bold := True; // Установить жирный шрифт
 MsWord.Selection.Font.Size := 12; // установить 12 кегль
 MsWord.Selection.TypeText('Текст');
Source: http://dmitry9.nm.ru/info/
ID: 04419
Category:COM
Category:MS Office
Как проверить находится ли файл на локальном диске?

=== Как проверить находится ли файл на локальном диске? ===
function IsOnLocalDrive(aFileName: string): Boolean;
var
 aDrive: string;
begin
 aDrive := ExtractFileDrive(aFileName);
 if (GetDriveType(PChar(aDrive)) = DRIVE_REMOVABLE)
 or (GetDriveType(PChar(aDrive)) = DRIVE_FIXED) then
 Result := True
 else
 Result := False;
end;
// Example, Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
 if IsOnLocalDrive(OpenDialog1.FileName) then
 ShowMessage(OpenDialog1.FileName + ' is on a local drive.');
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03168
Category:Файловая система
Как проверить правильность International Bank Account Number?

// IBAN = International Bank Account Number
// Example : CH10002300A1023502601
// A -> 10, B -> 11, C -> 12 ...
function ChangeAlpha(input: string): string;
var
 a: Char;
begin
 Result := input;
 for a := 'A' to 'Z' do
 begin
 Result := StringReplace(Result, a, IntToStr(Ord(a) - 55), [rfReplaceAll]);
 end;
end;
function CalculateDigits(iban: string): Integer;
var
 v, l: Integer;
 alpha: string;
 number: Longint;
 rest: Integer;
begin
 iban := UpperCase(iban);
 if Pos('IBAN', iban) > 0 then
 Delete(iban, Pos('IBAN', iban), 4);
 iban := iban + Copy(iban, 1, 4);
 Delete(iban, 1, 4);
 iban := ChangeAlpha(iban);
 v := 1;
 l := 9;
 rest := 0;
 alpha := ;
 try
 while v <= Length(iban) do
 begin
 if l > Length(iban) then
 l := Length(iban);
 alpha := alpha + Copy(iban, v, l);
 number := StrToInt(alpha);
 rest := number mod 97;
 v := v + l;
 alpha := IntToStr(rest);
 l := 9 - Length(alpha);
 end;
 except
 rest := 0;
 end;
 Result := rest;
end;
function CheckIBAN(iban: string): Boolean;
begin
 iban := StringReplace(iban, ' ', , [rfReplaceAll]);
 if CalculateDigits(iban) = 1 then
 Result := True
 else
 Result := False;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04046
Category:Алгоритмы
Category:Безопасность
Как проверить правильность штрих-кода?

Solve 1:
I want to publish a code for checksum calculation by modulus 10 which is used in the barcodes. I must say that this "mod10" is specifical so readf an article if you're interested.
This algorithm is very popular for UPC barcodes (Universal Product Code), hash code or serial number generation for applications etc...
The basic algorithm:
# add the values of the digits in the odd positions (1, 3, 5...)
# multiply this result by 3
# add the values of the digits in the even positions (2, 4, 6...)
# sum the results of steps 2 and 3
# the check digit is the smallest number which, when added to the result in step 4, produces a multiple of 10.
Small example. Assume the source data is 08137919805
 0+1+7+1+8+5=22
 22*3=66
 8+3+9+9+0=29
 66+29=95
 95+??=100 where ?? is a 5 (our checksum)
My implementation in the Pascal:
function Mod10(const Value: string): Integer;
var
 i, intOdd, intEven: Integer;
begin
 { add all odd seq numbers }
 intOdd := 0;
 i := 1;
 while (i <= Length(Value)) do
 begin
 Inc(intOdd, StrToIntDef(Value[i], 0));
 Inc(i, 2);
 end;
 { add all even seq numbers }
 intEven := 0;
 i := 2;
 while (i <= Length(Value)) do
 begin
 Inc(intEven, StrToIntDef(Value[i], 0));
 Inc(i, 2);
 end;
 Result := 3 * intOdd + intEven;
 { modulus by 10 to get }
 Result := Result mod 10;
 if Result <> 0 then
 Result := 10 - Result
end;
You can expand or optimize this algorithm for own needs.
For example, I modified it and now I use it for any characters (not only digits) in source value.
The original algorithm I used for UPC-barcode validation in the SMReport Designer and the my extended algorithm I use in the serial number generation as part of the protection schema (in the shareware projects).
ID: 04047
----
function BarCodeValid(ACode: string): Boolean;
var
 I: Integer;
 SumOdd, SumEven: Integer;
 ADigit, AChecksumDigit: Integer;
begin
 SumOdd := 0;
 SumEven := 0;
 for I := 1 to (Length(ACode) - 1) do
 begin
 ADigit := StrToIntDef(ACode[I], 0);
 if (I mod 2 = 0) then
 begin
 SumEven := SumEven + ADigit;
 end
 else
 begin
 SumOdd := SumOdd + ADigit;
 end;
 end;
 AChecksumDigit := StrToIntDef(ACode[Length(ACode)], 0);
 Result := ((SumOdd * 3 + SumEven + AChecksumDigit) mod 10 = 0);
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04048
Category:Алгоритмы
Category:Безопасность
Как проверить существование URL?

Данная функция позволяет Вам проверить существование определённого адреса(URL) в интернете. Естественно она может пригодиться веб-мастерам, у которых на сайте много ссылок, и необходимо с определённой периодичностью эти ссылки проверять.
URL может быть как с префиксом http:/ так и без него - эта функция добавляет префикс http:// если он отсутствует (необходимо для функции internetOpenUrl которая так же поддерживает FTP:// и gopher://
Эта функция проверяет только два возвращаемых кода '200' (ОК) или '302' (Редирект), но Вы можете заставить проверять функцию и другие коды. Для этого достаточно модифицировать строчку "result := ".
Платформа: Delphi 3.x (или выше)
uses wininet;
function CheckUrl(url: string): Boolean;
var
 hSession, hFile, hRequest: hInternet;
 dwIndex, dwCodeLen: DWord;
 dwCode: array[1..20] of Char;
 res: PChar;
begin
 if Pos('http://', lowercase(url)) = 0 then
 url := 'http://' + url;
 Result := False;
 hSession := InternetOpen('InetURL:/1.0',
 INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
 if Assigned(hSession) then
 begin
 hFile := InternetOpenUrl(hSession, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
 dwIndex := 0;
 dwCodeLen := 10;
 HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE, @dwCode, dwCodeLen, dwIndex);
 res := PChar(@dwCode);
 Result := (res = '200') or (res = '302');
 if Assigned(hFile) then
 InternetCloseHandle(hFile);
 InternetCloseHandle(hSession);
 end;
end;
Source: http://forum.sources.ru
ID: 03576
Category:Связь
Category:Web
Как проверить является ли текущее соединение в TWebbrowser secure (SSL)?

// You need a TWebbrowser, a TLabel
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
 const pDisp: IDispatch; var URL: OleVariant);
begin
 if Webbrowser1.Oleobject.Document.Location.Protocol = 'https:' then
 label1.Caption := 'Sichere Verbindung'
 else
 label1.Caption := 'Unsichere Verbindung'
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03457
Category:Связь
Category:WebBrowser
Как проверять корректность доступа к базе данных?

=== Как проверять корректность доступа к базе данных? ===
Следующая функция проверяет доступ к базе данных и выдает возможные причины, если доступ не удается осуществить. Функция возвращает значение True в случае успешной операции и False в противном случае.
function TBDEDirect.CheckDatabase: Boolean;
var
 DS: TDataSource;
begin
 Result := False;
 DS := GetDataSource;
 if DS = nil then
 begin
 MessageDlg('Не установлена связь с элементом-источником данных.' + sLineBreak +
 'Проверьте установку свойства DataSource.',
 mtError, [mbOK], 0);
 Exit;
 end;
 if DS.DataSet = nil then
 begin
 MessageDlg('Доступ к базе данных невозможен.', mtError,[mbOK], 0);
 Exit;
 end;
 if TDBDataSet(DS.DataSet).Database = nil then
 begin
 MessageDlg('Доступ к базе данных невозможен.', mtError,[mbOK], 0);
 Exit;
 end;
 if TDBDataSet(DS.DataSet).Database.Handle = nil then
 begin
 MessageDlg('Дескриптор (Handle) БД недоступен.', mtError,[mbOK], 0);
 Exit;
 end;
 if DS.DataSet.Handle = nil then
 begin
 MessageDlg('Дескриптор курсора (Cursor-Handle) недоступен.', mtError, mbOK], 0);
 Exit;
 end;
 Result := True;
end;
ID: 02539
Как проводить локализацию своих приложений

В Delphi есть специальные механизмы, позволяющие приложение "переделать" на любой язык после компиляции. Для D3 надо посмотреть в хелпе, по-моему, internationalization или что-то в этом роде. Для D4 вообще все делается ОЧЕНЬ просто:
* берется проект, компилируется
* тут-же не закрывая проект вызывается New|Resource DLL Wizard в нем указывается какие формы и модули должны подвергнуться переводу на другой язык.
* в результате работы Wizard появляется проект (!) с RC и DFM. Открываем формы, и переделываем все сообщения + размер (соотв. длине сообщений).
* Компилируем. В результате получается файл xxxxxxx.rus, где xxxxxxx - название исходного проекта.
* Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.
p.s. файл RUS можно подставлять и убирать по вкусу.
В Delphi3. Вот, случайно набpели в хэлпе. Если нужно изменить pесуpсы какого-либо модуля, то это можно делать с помощью нехитpой опеpации:
* Вынимаете pесуpсы из этого модуля.
* Пеpеводите их на дpугой язык. (напpимеp pусский)
* Создаете в Delphi свой пpоект Dll-ки (с именем того модуля, из котоpого вы вынули pесуpсы, напpимеp vcl30), в котоpый включаете пеpеведенные pесуpсы: {$R vcl30rus.res}
* Собиpаете все это.
* Пеpеименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.
Если вы хотите, пpиложение "говоpило" по pусски только тогда, когда в pегиональных установках стоит Russia - то тогда это все. Если же вы хотите, чтобы ваше пpиложение _всегда_ поднимало pусские pесуpсы, то необходимо сделать следующее добавление в Registry: 
 HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales "X:\MyProject\MyApp.exe" = "rus"
Тепеpь, когда ваше пpиложение будет поднимать pakages, то всегда будут бpаться pусские pесуpсы. Дpугие пpиложения, напpимеp Delphi - это не затpонет. Таким обpазом можно заменять даже DFM-ки из пpоекта.
Более подpобно об этом - см Help - Index - Localizing...
Source: http://delphiworld.narod.ru/
ID: 04557
ID: 04558
Category:Разработка приложений
Как программе удалить саму себя?

=== Как программе удалить саму себя? ===
Первый способ:
uses
 Windows, SysUtils;
procedure DeleteMe;
var
 BatchFile: TextFile;
 BatchFileName: string;
 ProcessInfo: TProcessInformation;
 StartUpInfo: TStartupInfo;
begin
 { создаём бат-файл в директории приложения }
 BatchFileName := ExtractFilePath(ParamStr(0)) + '$$336699.bat';
 { открываем и записываем в файл }
 AssignFile(BatchFile, BatchFileName);
 Rewrite(BatchFile);
 Writeln(BatchFile, ':try');
 Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
 Writeln(BatchFile,
 'if exist "' + ParamStr(0) + '"' + ' goto try');
 Writeln(BatchFile, 'del "' + BatchFileName + '"');
 CloseFile(BatchFile);
 FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
 StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
 StartUpInfo.wShowWindow := SW_HIDE;
 if CreateProcess(nil, PChar(BatchFileName), nil, nil,
 False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
 ProcessInfo) then
 begin
 CloseHandle(ProcessInfo.hThread);
 CloseHandle(ProcessInfo.hProcess);
 end;
end;
А вот тот же способ, но немного модифицированный:
program delete2;
uses
 SysUtils,
 windows;
var
 BatchFile: TextFile;
 BatchFileName: string;
 TM: Cardinal;
 TempMem: PChar;
begin
 BatchFileName := ExtractFilePath(ParamStr(0)) + '$$336699.bat';
 AssignFile(BatchFile, BatchFileName);
 Rewrite(BatchFile);
 Writeln(BatchFile, ':try');
 Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
 Writeln(BatchFile, 'if exist "' + ParamStr(0) + '" goto try');
 Writeln(BatchFile, 'del "' + BatchFileName + '"');
 CloseFile(BatchFile);
 TM := 70;
 GetMem(TempMem, TM);
 GetShortPathName(PChar(BatchFileName), TempMem, TM);
 BatchFileName := TempMem;
 FreeMem(TempMem);
 WinExec(PChar(BatchFileName), sw_hide);
 halt;
end.
Второй способ:
procedure DeleteSelf;
var
 module: HModule;
 buf: array[0..MAX_PATH - 1] of char;
 p: ULong;
 hKrnl32: HModule;
 pExitProcess,
 pDeleteFile,
 pFreeLibrary: pointer;
begin
 module := GetModuleHandle(nil);
 GetModuleFileName(module, buf, SizeOf(buf));
 CloseHandle(THandle(4));
 p := ULONG(module) + 1;
 hKrnl32 := GetModuleHandle('kernel32');
 pExitProcess := GetProcAddress(hKrnl32, 'ExitProcess');
 pDeleteFile := GetProcAddress(hKrnl32, 'DeleteFileA');
 pFreeLibrary := GetProcAddress(hKrnl32, 'FreeLibrary');
 asm
 lea eax, buf
 push 0
 push 0
 push eax
 push pExitProcess
 push p
 push pDeleteFile
 push pFreeLibrary
 ret
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 02089
Как программно добавить принтер?

Чтобы программно добавить принтер, необходимо воспользоваться API функцией AddPrinter, которая имеет три параметра:
* Имя принтера 
* Уровень печати 
* Описание принтера
Следующий пример является надстройкой для этой функции. Для этого необходимо знать Имя принтера, которое будет отображаться в Проводнике, имя порта, к которому подключён принтер (т.е. LPT1:), имя драйвера (придётся посмотреть вручную) и имя процессора печати (который обычно "winprint").
unit unit_AddPrinter;
interface
function AddAPrinter(PrinterName, PortName, DriverName, PrintProcessor: string): Boolean;
implementation
uses
 SysUtils,
 WinSpool,
 Windows;
function AddAPrinter(PrinterName, PortName, DriverName, PrintProcessor: string): Boolean;
var
 pName: PChar;
 Level: DWORD;
 pPrinter: PPrinterInfo2;
begin
 pName := nil;
 Level := 2;
 New(pPrinter);
 pPrinter^.pServerName := nil;
 pPrinter^.pShareName := nil;
 pPrinter^.pComment := nil;
 pPrinter^.pLocation := nil;
 pPrinter^.pDevMode := nil;
 pPrinter^.pSepFile := nil;
 pPrinter^.pDatatype := nil;
 pPrinter^.pParameters := nil;
 pPrinter^.pSecurityDescriptor := nil;
 pPrinter^.Attributes := 0;
 pPrinter^.Priority := 0;
 pPrinter^.DefaultPriority := 0;
 pPrinter^.StartTime := 0;
 pPrinter^.UntilTime := 0;
 pPrinter^.Status := 0;
 pPrinter^.cJobs := 0;
 pPrinter^.AveragePPM :=0;
 pPrinter^.pPrinterName := PCHAR(PrinterName);
 pPrinter^.pPortName := PCHAR(PortName);
 pPrinter^.pDriverName := PCHAR(DriverName);
 pPrinter^.pPrintProcessor := PCHAR(PrintProcessor);
 if AddPrinter(pName, Level, pPrinter) <> 0 then
 Result := True
 else
 begin
 // ShowMessage(inttostr(GetlastError));
 Result := False;
 end;
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 03212
Category:Принтер
Как программно заставить выпасть меню?

=== Как программно заставить выпасть меню? ===
В примере показано как показать меню и выбрать в нем какой-то пункт, эмулируя нажатие "быстрой клавиши" пункта меню. Если у Вашего пункта меню нет "быстрой клавиши" Вы можете посылать комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы программно "путешествовать" по меню.
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Allow button to finish painting in response to the click
 Application.ProcessMessages;
 { Alt Key Down }
 keybd_Event(VK_MENU, 0, 0, 0);
 { F Key Down - Drops the menu down }
 keybd_Event(ord('F'), 0, 0, 0);
 { F Key Up }
 keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0);
 { Alt Key Up }
 keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
 { S Key Down }
 keybd_Event(ord('S'), 0, 0, 0);
 { S Key Up }
 keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0);
end;
Source: Взято из http://forum.sources.ru
ID: 01301
Как программно перевести DBGrid в режим редактирования

=== Как программно перевести DBGrid в режим редактирования ===
Переведите таблицу в режим редактирования, затем получите дескриптор (handle) окна редактирования и перешлите ей сообщение EM_SETSEL. В качестве параметров вы должны переслать начальную позицию курсора, и конечную позицию, определяющую конец выделения текста цветом. В приведенном примере курсор помещается во вторую позицию, текст внутри ячейки не выделяется.
procedure TForm1.Button1Click(Sender: TObject);
var
 h: THandle;
begin
 Application.ProcessMessages;
 DbGrid1.SetFocus;
 DbGrid1.EditorMode := true;
 Application.ProcessMessages;
 h:= Windows.GetFocus;
 SendMessage(h, EM_SETSEL, 2, 2);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03054
Category:Базы данных
Category:DBGrid
Как программно переключить раскладку клавиатуры

=== Как программно переключить раскладку клавиатуры ===
// На русский
procedure TForm1.Button1Click(Sender: TObject);
var
 Layout: array[0.. KL_NAMELENGTH] of char;
begin
 LoadKeyboardLayout(StrCopy(Layout, '00000419'), KLF_ACTIVATE);
end;
// На английский
procedure TForm1.Button2Click(Sender: TObject);
var
 Layout: array[0.. KL_NAMELENGTH] of char;
begin
 LoadKeyboardLayout(StrCopy(Layout, '00000409'), KLF_ACTIVATE);
end;
Source: http://delphiworld.narod.ru/
ID: 01975
----
Эта программа при нажатии на Button1 меняет язык на следующий, при нажатии на Button2 - на русский, а на Button3 - на английский. Каждую секунду программа выводит в заголовок окна число, определяющее текущий язык. 
procedure TForm1.Button1Click(Sender: TObject);
begin
 ActivateKeyboardLayout(HKL_NEXT, 0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 ActivateKeyboardLayout(LoadKeyboardLayout('00000419', 0), 0);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
 ActivateKeyboardLayout(LoadKeyboardLayout('00000409', 0), 0);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
 s: array [0..63] of char;
begin
 GetKeyboardLayoutName(s);
 Form1.Caption := s;
end; 
Source: http://delphiworld.narod.ru/
ID: 01976
Как программно прокрутить Memo?

=== Как програмно прокрутить Memo? ===
Этот пример прокручивает на одну строку вниз.
memo1.Perform(WM_VScroll, SB_LINEDOWN, 0);
Возможны так же следующие опции:
* SB_BOTTOM
* SB_ENDSCROLL
* SB_LINEDOWN 
* SB_LINEUP 
* SB_PAGEDOWN
* SB_PAGEUP 
* SB_THUMBPOSITION
* SB_THUMBTRACK 
* SB_TOP
TComboBox, TListBox, TRichEdit и т.п можно прокрутить подобным образом 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00545
----
В поле ввода вводите на какую строку нужно сойти, и по нажатию на кнопку эта строка будет попадать о зону видимости: 
procedure TForm1.Button1Click(Sender: TObject);
var
 line: integer;
begin
 line := StrToIntDef(Edit1.Text, 1);
 Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, line, 0);
 Memo1.Perform(EM_SCROLLCARET, 0, 0);
end;
Source: http://delphiworld.narod.ru/
ID: 00993
----
var
 ScrollMessage: TWMVScroll;
begin
 ScrollMessage.Msg := WM_VScroll;
 for i := Memo1.Lines.Count downto 0 do
 begin
 ScrollMessage.ScrollCode := sb_LineUp;
 ScrollMessage.Pos := 0;
 Memo1.Dispatch(ScrollMessage);
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01008
Как программно реализовать Cut, Copy и Paste?

=== Как программно реализовать Cut, Copy и Paste? ===
Следующие операции производятся с активным контролом на форме:
procedure TForm1.Cut1Click(Sender: TObject);
begin
 SendMessage(ActiveControl.Handle, WM_Cut, 0, 0);
end;
procedure TForm1.Copy1Click(Sender: TObject);
begin
 SendMessage(ActiveControl.Handle, WM_Copy, 0, 0);
end;
procedure TForm1.Paste1Click(Sender: TObject);
begin
 SendMessage(ActiveControl.Handle, WM_Paste, 0, 0);
end;
Если Вы разрабатываете приложение MDI, то необходимо отправлять сообщение в активное дочернее окно, т.е. использовать: ActiveMDIChild.ActiveControl.Handle
Source: Взято из http://forum.sources.ru
ID: 01873
Как программно создать ярлык?

=== Как программно создать ярлык? ===
uses ShlObj, ComObj, ActiveX;
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
 IObject: IUnknown;
 SLink: IShellLink;
 PFile: IPersistFile;
begin
 IObject := CreateComObject(CLSID_ShellLink);
 SLink := IObject as IShellLink;
 PFile := IObject as IPersistFile;
 with SLink do
 begin
 SetArguments(PChar(Param));
 SetDescription(PChar(Desc));
 SetPath(PChar(PathObj));
 end;
 PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;
Source: Взято из http://forum.sources.ru
ID: 01738
Как программно установить конфигурацию COM-порта в Windows 95?

=== Как программно установить конфигурацию COM-порта в Windows 95? ===
procedure TForm1.Button1Click(Sender: TObject); 
var 
 CommPort: string; 
 hCommFile: THandle; 
 Buffer: PCommConfig; 
 size: DWORD; 
begin 
 CommPort := 'COM1'; 
 { Открываем Com-порт } 
 hCommFile := CreateFile(PChar(CommPort), 
 GENERIC_WRITE, 
 0, 
 nil, 
 OPEN_EXISTING, 
 FILE_ATTRIBUTE_NORMAL, 
 0); 
 if hCommFile = INVALID_HANDLE_VALUE then 
 begin 
 ShowMessage('Unable to open '+ CommPort); 
 exit; 
 end; 
 { Выделяем временный буфер } 
 GetMem(Buffer, sizeof(TCommConfig)); 
 { Получаем размер структуры CommConfig }
 size := 0; 
 GetCommConfig(hCommFile, Buffer^, size); 
 { Освобождаем временный буфер }
 FreeMem(Buffer, SizeOf(TCommConfig)); 
 { Выделяем память для структуры CommConfig } 
 GetMem(Buffer, size); 
 GetCommConfig(hCommFile, Buffer^, size); 
 { Изменяем скорость передачи } 
 Buffer^.dcb.BaudRate := 1200; 
 { Устанавливаем новую конфигурацию для COM-порта }
 SetCommConfig(hCommFile, Buffer^, size); 
 { Освобождаем буфер } 
 FreeMem(Buffer, size); 
 { Закрываем COM-порт }
 CloseHandle(hCommFile); 
end;
Source: Взято из http://forum.sources.ru
ID: 01342