Здравствуйте уважаемые подписчики рассылки "Интернет для Delphi программиста". Данная рассылка предназначена для всех кого интересует Delphi, здесь будут выкладываться ссылки на различные ресурсы интернета так или иначе связанные с Delphi: книги, исходники, программы... Изучайте Delphi один из лучших языков программирования!!!

ЗАДАТЬ ВОПРОС :

Правила рассылки: 
1. Не присылайте ответов на вопросы типа "да, нет".  
2. Если отвечаешь на вопрос - то отвечай подробно с примерами (желательно с исходником примера).
3. Тема вопросов - программирование на Delphi.
Внимание авторам: - Я не указываю ваши адреса из-за спама, но кто хочет, чтобы его email был - пишите, иначе только имя(ник).
Отправить вопрос

Новые вопросы.

repeat
sred := ((max - min) div 2) + min;
if a[sred] = obrazets
then
found := True
else
 if a[sred] > obrazets
then max := sred  //здесь если вместо этого поставить max := sred + 1 ,
//то в ходе программы ничего не меняется
else min := sred; //Здесь так же min := sred -1 ничего не дает
 until (min > max) or found;
end

Ответы.

procedure ShutdownComputer;
var
  ph: THandle;
  tp, prevst: TTokenPrivileges;
  rl: DWORD;
begin
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or
    TOKEN_QUERY, ph);
  LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tp.Privileges[0].Luid);
  tp.PrivilegeCount := 1;
  tp.Privileges[0].Attributes := 2;
  AdjustTokenPrivileges(ph, FALSE, tp, SizeOf(prevst), prevst, rl);
  ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0);
end;

1.
Как завершить сеанс работы или перезагрузить Windows NT
--------------------------------------------------------------------------------

Для этого нам потребуются определённые привилегии:

function SetPrivilege(aPrivilegeName: string;
  aEnabled: boolean): boolean;
var
  TPPrev,
    TP: TTokenPrivileges;
  Token: THandle;
  dwRetLen: DWord;
begin
  Result := False;
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES
    or TOKEN_QUERY, @Token);

  TP.PrivilegeCount := 1;
  if (LookupPrivilegeValue(nil, PChar(aPrivilegeName),
    TP.Privileges[0].LUID)) then
  begin
    if (aEnabled) then
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    else
      TP.Privileges[0].Attributes := 0;

    dwRetLen := 0;
    Result := AdjustTokenPrivileges(Token, False, TP,
      SizeOf(TPPrev),
      TPPrev, dwRetLen);
  end;
  CloseHandle(Token);
end;

function WinExit(iFlags: integer): boolean;
//   возможные флаги:
//   EWX_LOGOFF
//   EWX_REBOOT
//   EWX_SHUTDOWN
begin
  Result := True;
  if (SetPrivilege('SeShutdownPrivilege', true)) then
  begin
    if (not ExitWindowsEx(iFlags, 0)) then
    begin
      Result := False;
    end;
    SetPrivilege('SeShutdownPrivilege', False)
  end
  else
  begin
    Result := False;
  end;
end;

 
2.
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Перезагрузка в WinNT (Убивает процессы)

Зависимости: Windows
Автор:       DeMoN-777, DeMoN-777@yandex.ru, Санкт-Петербург
Copyright:   @
Дата:        21 июня 2002 г.
***************************************************** }

procedure reboot2;
var
  hToken: THandle;
  tkp: _TOKEN_PRIVILEGES;
  DUMMY: PTokenPrivileges;
  DummyRL: Cardinal;
begin
  DUMMY := nil;
  if not OpenProcessToken(
    GetCurrentProcess(),
    TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
    hToken
    ) then
    raise TShutdownEx.Create('OpenProcessToken failed');

  if (not LookupPrivilegeValue(nil, 'SeShutdownPrivilege',
    tkp.Privileges[0].Luid)) then
    raise TShutdownEx.Create('LookupPrivilegeValue failed');

  tkp.PrivilegeCount := 1;
  tkp.Privileges[0].Attributes := $0002; //SE_PRIVILEGE_ENABLED = $00002

  AdjustTokenPrivileges(hToken, FALSE, tkp, 0, Dummy, DummyRL);

  if (GetLastError() <> ERROR_SUCCESS) then
    raise TShutdownEx.Create('AdjustTokenPrivileges failed');

  if (not ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0)) then
    raise TShutdownEx.Create('ExitWindowsEx failed');
end;


3.
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Перезагрузка в WinNT (не убивает процессы)

Зависимости: Windows
Автор:       DeMoN-777, DeMoN-777@yandex.ru, Санкт-Петербург
Copyright:   @
Дата:        21 июня 2002 г.
***************************************************** }

procedure reboot;
var
  hToken: THandle;
  tkp: _TOKEN_PRIVILEGES;
  DUMMY: PTokenPrivileges;
  DummyRL: Cardinal;
begin
  DUMMY := nil;
  if not OpenProcessToken(
    GetCurrentProcess(),
    TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
    hToken
    ) then
    raise TShutdownEx.Create('OpenProcessToken failed');

  if (not LookupPrivilegeValue(nil, 'SeShutdownPrivilege',
    tkp.Privileges[0].Luid)) then
    raise TShutdownEx.Create('LookupPrivilegeValue failed');

  tkp.PrivilegeCount := 1;
  tkp.Privileges[0].Attributes := $0002; //SE_PRIVILEGE_ENABLED = $00002

  AdjustTokenPrivileges(hToken, FALSE, tkp, 0, Dummy, DummyRL);

  if (GetLastError() <> ERROR_SUCCESS) then
    raise TShutdownEx.Create('AdjustTokenPrivileges failed');

  if (not ExitWindowsEx(EWX_REBOOT, 0)) then
    raise TShutdownEx.Create('ExitWindowsEx failed');
end;

uses windows;
var
  l,k : DWORD;
  hToken : THandle;
  tkp : TTokenPrivileges;
  result : bool;
BEGIN

  //l := EWX_POWEROFF;
  //l := EWX_REBOOT;
  l := EWX_LOGOFF;
  result := false;

  // Get a token for this process.
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
  begin
        // Get the LUID for the shutdown privilege.
        LookupPrivilegeValue(nil, 'SeSecurityPrivilege', tkp.Privileges[0].Luid);

        tkp.PrivilegeCount := 1;  // one privilege to set
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

        // Get the shutdown privilege for this process.
        k := 0;
        AdjustTokenPrivileges(
                hToken,
                FALSE,
                tkp,
                0,
                PTokenPrivileges(nil),
                k);

        // Cannot test the return value of AdjustTokenPrivileges.
        if (GetLastError() = ERROR_SUCCESS) then
        begin
             result := ExitWindowsEx( l, 0);
        end;
  end;
END.

var
  a: integer;
  b: real;

  // a присваиваем целое число
  a := StrToInt( Edit1.Text );
  // b присваиваем вещественное число
  b := StrToFloat( Edit2.Text );

var
a:integer; b:extended; // а - целочисленная b - вещественная
begin
        a:=StrToInt(Edit1.Text);
        b:=StrToFloat(Edit1.Text);

        Edit1.Text:=IntToStr(a); //занесение числа в компонент.
end

Да все нормально. Я сделал то же самое,
и все превосходно работает.

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
   case Key of
      '.',',': if Key <> DecimalSeparator then
                  Key := DecimalSeparator;
   end;
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
case Key of
'.',',':  begin
                if Key <> DecimalSeparator
                then Key := DecimalSeparator;
                  {можно это добавить}
                if Pos(StringGrid1.Cells[StringGrid1.Col,0], DecimalSeparator) <> 0
                        then Key:=Char(0);
            end;  //надо закрыть блок!!!     
     

во первых делай на OnKeyDown
а во вторых :) используй функцию -> Pchar(String)

var s:string;
begin
PChar(s);
end
 и получишь что хотел

Сегодня наша программа научится работать с CheckBox'ами. CheckBox можно представить как "флаг", который можно установить или сбросить, и в зависимости от его состояния выполнять определенные действия. Программисты очень часто используют этот элемент управления, так что давайте, разберемся, как это делается на Win API.

Помимо CheckBox'ов, на форме присутствуют метки ("Static") и кнопки ("Button"), но их я рассматривать не буду, так как мы уже умеем с ними работать. Как обычно, начнем с объявления констант и переменных.

const IDChBox1 = WM_USER+1; IDChBox2 = WM_USER+2; IDChBox3 = WM_USER+3; IDBtn1 = WM_USER+4; IDBtn2 = WM_USER+5; var ChBox1: HWND; ChBox2: HWND; ChBox3: HWND; Label1: HWND; Label2: HWND; Btn1: HWND; Btn2: HWND;

Обратим внимание на то, как задаются константы. Как вы знаете, взаимодействие Windows с приложениями происходит по средствам сообщений. Но не всегда программисту бывает достаточно тех сообщений, которые предопределены в системе. Windows позволяет программисту создать свое, так называемое, пользовательское сообщение. Весь диапазон чисел ниже $0400 (WM_USER) зарезервирован под системные сообщения, следовательно, пользовательские сообщения должны начинаться с WM_USER+1.

Но ведь раньше мы так не делали. Почему? Я просто хотел показать, что даже если мы не будем следовать этому правилу, Windows не допустит конфликтов в таком важном для работы системы механизме, как сообщения. Ведь от этого напрямую зависит надежность работы операционной системы. Рассмотренный сейчас способ является более правильным, по этому в дальнейшем, мы будем использовать именно его.

Вернемся к CheckBox'ам и посмотрим, как они создаются.

ChBox1 := CreateWindowEx( 0, 'Button', 'BS_AUTOCHECKBOX', WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX, 10, 10, 130, 25, Wnd, IDChBox1, hinstance, nil ); SendMessage( ChBox1, WM_SETFONT, GetStockObject( ANSI_VAR_FONT ), 0 ); ChBox2 := CreateWindowEx( 0, 'Button', 'BS_AUTO3STATE', WS_CHILD or WS_VISIBLE or BS_AUTO3STATE, 155, 10, 110, 25, Wnd, IDChBox2, hinstance, nil ); SendMessage( ChBox2, WM_SETFONT, GetStockObject( ANSI_VAR_FONT ), 0 ); ChBox3 := CreateWindowEx( 0, 'Button', 'BS_CHECKBOX', WS_CHILD or WS_VISIBLE or BS_CHECKBOX, 10, 65, 100, 25, Wnd, IDChBox3, hinstance, nil ); SendMessage( ChBox3, WM_SETFONT, GetStockObject( ANSI_VAR_FONT ), 0 );

Здесь нужно обратить внимание на стиль каждого из CheckBox'ов, а именно: BS_AUTOCHECKBOX, BS_AUTO3STATE и BS_CHECKBOX. Рассмотрим каждое немного подробнее. BS_AUTOCHECKBOX - CheckBox имеет два состояния: флажок либо установлен, либо сброшен. BS_AUTO3STATE - CheckBox имеет три состояния: первые два, как у BS_AUTOCHECKBOX, и третье (назовем его неопределенным), когда флажок установлен, но фон окрашен серым цветом вместо белого. BS_CHECKBOX - аналогичен BS_AUTOCHECKBOX за тем исключением, что задача по установке и сбросу флажка ложится на программиста (при клике по BS_AUTOCHECKBOX и BS_AUTO3STATE, их состояние меняется автоматически).

Посмотрим, как нужно обрабатывать событие, вызванное щелчком по CheckBox'у.

function WindowProc( Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall; var Res: LRESULT; begin case Msg of WM_DESTROY: begin PostQuitMessage( 0 ); Result := 0; Exit; end; WM_COMMAND: case LoWord( wParam ) of // Обрабатываем BS_AUTOCHECKBOX IDChBox1: begin Res := SendMessage( ChBox1, BM_GETCHECK, 0, 0 ); case Res of BST_CHECKED: SetWindowText( Label1, 'Состояние: включен' ); BST_UNCHECKED: SetWindowText( Label1, 'Состояние: выключен' ); end; end; // Обрабатываем BS_AUTO3STATE IDChBox2: begin Res := SendMessage( ChBox2, BM_GETCHECK, 0, 0 ); case Res of BST_CHECKED: SetWindowText( Label2, 'Состояние: включен' ); BST_INDETERMINATE: SetWindowText( Label2, 'Состояние: неопределено' ); BST_UNCHECKED: SetWindowText( Label2, 'Состояние: выключен' ); end; end; // Обрабатываем BS_CHECKBOX IDChBox3: begin Res := SendMessage( ChBox3, BM_GETCHECK, 0, 0 ); case Res of BST_CHECKED: CheckDlgButton( Wnd, IDChBox3, 0 ); BST_UNCHECKED: CheckDlgButton( Wnd, IDChBox3, 1 ); end; end; IDBtn1: CheckDlgButton( Wnd, IDChBox3, 0 ); IDBtn2: CheckDlgButton( Wnd, IDChBox3, 1 ); end; else Result := DefWindowProc( Wnd, Msg, wParam, lParam ); end; end;

Как видите, в этом нет ничего сложного. Используя сообщение BM_GETCHECK, мы узнаем, в каком состоянии находится CheckBox (для наглядности мы выводим соответствующую надпись в поле "Static"). Что касается BS_CHECKBOX, то, как говорилось выше, его состояние программист должен задавать сам. В этом нам поможет функция CheckDlgButton. Если нам надо сбросить флажок, то в третьем параметре мы передаем 0. Любое другое, отличное от нуля, значение приведет к тому, что флажок будет установлен. Значение последнего параметра не может быть отрицательным.

На сегодня все. Удачи в программировании.

.: Пример к данной статье :.

PGP Components for Delphi v.3.3.5

Эти исходники обеспечивают прямой доступ к PGP. Могут кодировать и декодировать, импортировать, экспортировать, удалять ключи, генерировать ключи (DH/DSS, RSA), а также выполнять другие функции.

Fnugry Netstat Components v.1.00

Набор компонентов, позволяющих разработчику получать различную статистику, наподобие работы утилиты Netstat.exe.

TMessenger v.2.0

Компонент для коммуникации с несколькоми дополнительными аозможностями.

ALMailSlot v.1.06

Компонент, позволяющий приложениям связываться по сети.

TLanView v.1.0

Просмотр компьютеров в сети, с дополнительными методами.

GRID VIEW 1.9

GridView это компонент для размещения, управления и отображения данных пользователя в GRID. Возможности: - работа с более чем 10,000,000 ячейками в реальном режиме; - ячейки в grid могут содержать Text, Number, Image, CheckBox и ProgressBar, ComboBox; - быстрая и умная сортировка столбцов; - строка ввода для быстрого ввода (как в Outlook); - перемещение и автоматическое изменение размеров столбцов; - отображение данных в различных стилях (Report, Slides). Новое: -TDateColumn с date picker -сортировка типов Numeric и Date.

TswStringGrid v.1.0

TswStringGrid является наследником TStringGrid. Добавлено несколько новых особенностей: Событие OnHeadClick, подобное OnTitleClick у компонента TDBGrid. Метод Sort, подобный такому же методу у TListView. Метод сортировки выбираемый. Событие OnCompare, подобное одноимённому у TListView. Возможность записывать строки в текстовый файл и загружать строки в Grid из файла, созданного компонентом.

TAdvString Grid v.2.4

TAdvStringGrid - это StringGrid с дополнительными возможностями: вставка/удаление/перемещение строк и столбцов копирование/вставка в клипборд сохранение/загрузка в файл внутреннего формата сохранение/загрузка/добавление в CSV-файл сохранение/загрузка в XLS-файл сохранение/загрузка в поток сохранение в HTML сохранение в форматированный текстовый файл выравнивание ячеек, раскрашивание фона и шрифта, автоматическая распечатка с титулом, нумерацией страниц, вставка даты, времени, бордюра, заголовка и еще много чего полезного (см. комментарии).

VideoLab v.2.1

OpenWire Video Lab множество компонентов, основанные на OpenWire 2.x для быстрой обработки видео. Они позволяют быстро производить множество манипуляций с видео без единой строки кода.
Цена: 50$

TVideoCapture v.1.10

Компонент для захвата видео и изображений. Требует DirectShow и DX8.

Local Heap Memory Manager v.1.0

Знаете ли вы, что использование Sharemem в Delphi замедляет все операции с памятью, даже если они не в DLL'ах? FastShareMem быстр, легок, бесплатен, замена Sharemem в Delphi. Особенности: Очень быстр (примерно в 8 раз быстрее), не требует DLL в отличие от ShareMem

MACAddress

Две функции для получения MAC-адресов сетевых адаптеров.

HotKeys

Эта программа, которая позволяет вам определять горячие клавиши, чтобы: запускать приложения, посылать нажатия клавиш в другие приложения, минимизировать все окна, выходить из Win, перезагрузка Win.

TinWin

Программа считает сколько секунд запущен Windows

FormatDrv

Пример форматирование дисков из Delphi

TextCode

Замена текста набранной в другой кодеровке

ProcessKillers

Убивание процессов

http://www.noil.pri.ee/ - Здесь вы можете почитать статьи, скачать исходники и компоненты, пообщаться на форуме.

---

Правило левой и правой руки сисадмина при возникновении проблемы.
Левой рукой взять юзера за грудки.
Правой рукой дать в морду.

---

Insufficient Disc Space, please delete a Window..... Please!!!

---

Два "новых русских" сидят за компом.
У одного в руках многозарядная винтовка, у другого - копошится живая мышка. Оба молча смотрят на черный экран монитора.
Наконец тот, у которого мышка, достает мобильник и звонит:
- Але! Ну че, че-то опять не работает... Да уже и винчестер купили и мышку...а он опять не работает.

---

- Мам, а мам, а можно я сегодня початюсь?
- Ладно, сынок, только недолго. Далеко не ходи, только на местные узлы, с незнакомыми не разговаривай. 

---

Афоризмы про интернет

Ищу выход из Интеpнета...
Конкурс детских сайтов «Урлёнок»
Коннект здесь больше не живёт!
Кто юзал мой логин и весь его выюзал?!
Модема-модема, чyкча почту хочет!
На выпуск зубной щётки «Colgate Navigator», Aquafresh ответила своей новой разработкой - «Aquafresh Explorer»
Нет, не перевёлся ещё carrier в наших линиях
О человеке можно судить по его Temporary Internet Files...
Объявление: лечу от запоев, ожирения и Интернет. Бабка Меланья.
...однажды буддист, сатанист, эксгибиционист и модератор... 
Пенти - ум, а Интер - нет.
Позвольте Вас, мадам, немного пингануть...
Пошёл старик к синему морю, стал он кликать золотую рыбку. "Error 404", - откликнулась золотая рыбка.
При звуках коннекта теряет волю.
При пожаре звонить ATDP901^M.
Продаётся модем, подключённый к Интернет.
Серьёзная организация возьмёт на высокооплачиваемую должность опытного хакера. Резюме просим размещать на главной странице сайта www.microsoft.com.
Сидим, как в деревне! Ни радио, ни телевизора - один Интернет остался!
Тамбовский волк тебе провайдер...
Тянем-потянем, вытянуть... No carrier.
Богоматерь.ico 
Большой программе - большие глюки.
В свои 20 лет он знал 9 операционных систем и ни одной женщины.
Вирус детям не игрушка, не товарищ и не друг!
Во имя процесса-отца, процесса-сына и святаго root'а... Enter!
Всю ночь потел над непослушной Клавой...
Гарри Каспаров наконец-то выиграл у компьютера, и с двумя очками и тремя жизнями перешёл на следующий уровень.
Да освятится имя твоё и расширение твоё, Господи...
Да поможет нам "F1", и да сохранит нас "F2"
Долгое время считалось, что бит неделим. Но советские учёные...
АТС 73 защищает ваши модемы от каppиеpа с утра и до вечера...
В KOI-то веки...
Веб-мастер и Маргарита
Возвращается муж внезапно домой из Интернета...
Вот сидит паренек - без пяти минут веб-мастер.
Горе ты моё аутлуковое!
Дружбы народов надёжный applet.
И было у него три сына. Один умный, второй дурак, а третий вообще фидошник.
...и молодая не узнает, какой у парня был connect...
Интеpнетчики озадачены: есть ли жизнь в офф-лайне?..
Истинную цену живого человеческого общения по-настоящему понимаешь, только глядя на счета от провайдера. 
001, 010, 011, 100, 101 - вышел зайчик погулять 
3 кнопки, которые потрясли DOS 
4 Mb - это не память. Это склероз. 
16 мегабайт тому назад... 
А ваших резидентов мы на прерываниях перевешаем!
А кофе на клавиатуру тоже вирус пролил? 
А руки сами тянутся к Reset'у 
«АБЫРВАЛГ!», сказал линyкс после русификации
Бит - это байт минус налоги 

---

Дружественная рассылка:

Все кто хочет изучить Delphi и реально научиться писать свои программы, ЦПИ "Эверест" поможет Вам.
Всё, что Вам нужно это компьютер и доступ к интернету - для получения уроков.

10 причин в пользу платного обучения в ЦПИ "Эверест"…

1. Когда Вы платите деньги- появляется дополнительный стимул против лени: надо учиться, ведь деньги уже уплачены….
2. Учась платно, получаете удобный для Вас график работы.
3. Весь необходимый справочный материал Вы получите в свое время и на русском языке.
4. Используя интернет в качестве бесплатной библиотеки, Вы получаете все ее минусы:

• трата времени на поиск необходимого материала (а это потерянные деньги и время). А у Вас есть лишние время и деньги?;
• отсутствие гарантии, что Вы "осилите" данный материал, ведь пишут его, в основном, не педагоги- профессионалы, а программисты- профессионалы, а они пишут для таких же, как они. А Вы программист- профессионал?
• отсутствие системности в скачиваемом материале (ведь человек, писавший для Вас материал, не знает, чем Вы владеете). А Вы обладаете системой знаний по Delphi?;

5. Стоимость обучения одного месяца в ЦПИ "Эверест" сравнима с ценой хорошей книги. Но часто ли Вам попадались книги, рассчитанные именно на Вас. Мы же работаем индивидуально.
6. Автор книги или магазин не несет никакой ответственности за то, поняли ли Вы материал или нет, мы же закрепляем за каждым курсантом преподавателя, курирующего Вас.
7. Освоив программирование в Delphi - Вы освоите:

• основы настоящего программирования- структурного и процедурного программирования ;
• систему работы с базами данных и SQL- запросами, а это одно из самых перспективных направлений в программировании;
• язык программирования ObjectPascal, что позволит Вам легко перейти, при желании, на С или Паскаль;
• работу с компьютерной графикой;
• при желании - основы низкоуровневого программирования ( Ассемблер).

8. А это значит, что …Мы предлагаем получить "высшее образование" - профессию программиста всего за 1 год и 144 доллара, любой ВУЗ попросит в 3 раза больше за один только семестр.
9. Вы получаете самый практический курс в сети, поскольку теория дается только тогда, когда она действительно необходима…
10. Учиться у нас легко и просто. Весь материал доступен и простым людям, не имеющим никогда дел с программированием….

По всем вопросам обращайтесь ко мне.

Если вы встретили в интернете интересный сайт или статью, да и вообще, что угодно связанное с Delphi, поделитесь ссылкой.
Если можете написать статью связанную с Delphi - присылайте с радостью выложу.
Давайте поможем друг другу!  Архив рассылки.

Предложения, критику и пожелания пишите на e-mail.