Отправляет email-рассылки с помощью сервиса Sendsay

Мастера DELPHI. Новости мира компонент, FAQ, статьи...

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Май 2004   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.577 подписчиков
-18 за неделю
←   Все выпуски   →

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

Выпуск от 23.05.04 09:17

Лучшее из нашего FAQ   |x|
Мне нужно сделать такую прогу, которая будет работать как командная строка в windows2000. Только параметры для команды должны вводится в editы 
unit admin;

interface

uses Windows, Classes, syncobjs, SysUtils;

type
TConsole=class(TThread)
private
 FWnd:THandle;
 FMsg:Cardinal;
 ChildStdInWr,ChildStdoutRd:THandle;
 FCS:TCriticalSection;
 FCommandList:TStringList;
 procedure CreateConsole;
protected
 procedure Execute;override;
public
 constructor Create(AWnd:THandle; AMsg:Cardinal);reintroduce;
 procedure AddCommand(s:string);
end;

implementation

{ TConsole }

constructor TConsole.Create(AWnd:THandle; AMsg:Cardinal);
begin
 FWnd:=AWnd;
 FMsg:=AMsg;
 FCS:=TCriticalSection.Create;
 FCommandList:=TStringList.Create;
 inherited Create(false);
end;

procedure TConsole.AddCommand(s:string);
begin

FCS.Enter;
 try
   FCommandList.Add(s+#13#10);<
 br> finally
   FCS.Leave;
 end;
end;

procedure TConsole.Execute;
var
 buffer:Pointer;
 bytesRead:DWORD;
begin
 CreateConsole;
 while not Terminated do
 begin
   sleep(200);
   PeekNamedPipe(ChildStdoutRd,nil,0,nil,@bytesRead,nil);

   //?eoaai
   if bytesRead>0 then
   begin
     GetMem(buffer,bytesRead+1);
     try
       if not ReadFile(ChildStdoutRd,buffer^,bytesRead,bytesRead,nil) then
         RaiseLastWin32Error;
       PChar(buffer)[bytesRead]:=#0;
       SendMessage(FWnd,FMsg,Integer(PChar(buffer)),0);
     finally
    
  FreeMem(buffer);
     end;
   end;
 

   //Ieoai
   FCS.Enter; &nbs
p; try
     while FCommandList.Count>0 do
     begin
       if not WriteFile(ChildStdinWr,PChar(FCommandList[0])^,Length(FCommandList[0]),bytesRead,nil) then
         RaiseLastWin32Error;
       FCommandList.Delete(0);
     end;
   finally
     FCS.Leave;
   end;
 end;
end;

procedure TConsole.CreateConsole;
var
 sa:TSecurityAttributes;
 si:TStartupInfo;
 pi:TProcessInformation;
 comSpec:PChar;
 bufLen:DWORD;
 ChildStdoutWr, ChildStdInRd, Tmp1, Tmp2:THandle;
begin
 sa.nLength:=sizeof(TSecurityAttributes);
 sa.bInheritHandle:=true;
 sa.lpSecurityDescriptor:=nil;

 if not CreatePipe(ChildStdoutRd,
ChildStdoutWr, @sa, 0) then
   RaiseLastWin32Er
 ror;
 if not CreatePipe(ChildStdinRd, ChildStdinWr, @sa, 0) then
   RaiseLastWin32Error;

 if not DuplicateHandle(GetCurrentProcess(), ChildStdoutRd, GetCurrentProcess(), @Tmp1, 0, False, DUPLICATE_SAME_ACCESS) then
   RaiseLastWin32Error;
 if not DuplicateHandle(GetCurrentProcess(), ChildStdinWr, GetCurrentProcess(), @Tmp2, 0, False, DUPLICATE_SAME_ACCESS) then
   RaiseLastWin32Error;

 CloseHandle(ChildStdoutRd);
 CloseHandle(ChildStdinWr);
 ChildStdoutRd:=Tmp1;
 ChildStdinWr:=Tmp2;

 bufLen:=GetEnvironmentVariable('ComSpec',nil,0);
 GetMem(comSpec,bufLen);
 GetEnvironmentVariable('ComSpec',comSpec,bufLen);

 GetStartupInfo(si);
 si.cb:=sizeof(TStartupInfo);
 si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
 si.hStdInput:=ChildStdInRd;

si.hStdOutput:=ChildStdOutWr;
 si.hStdError:=ChildStdOutWr;
 si.wShowWindow:=S
 W_HIDE;
 if not CreateProcess(nil,comSpec,nil,!
 nil,true
,CREATE_NEW_CONSOLE,nil,nil,si,pi) then
   RaiseLastWin32Error;
end;
end.

пример использования
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Admin,
 StdCtrls;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   c:TConsole;
   procedure Z(var Msg:TMessage);message WM_USER+1;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 c:=TConsole.Create(Handle,WM_USER+1);

c.AddCommand('ping 192.168.1.23');
end<
 /b>;

procedure TForm1.Z(var Msg: TMessage);
var
p:PChar;
begin
 p:=PChar(Msg.wParam);
 OemToCharBuff(p,p,length(p));
 Memo1.Lines.Add(p);
end;
end.

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
  • Сохранение игры
    Я создаю игру - текстовый квест. У героя будет несколько характеристик. Как запрограммиравать сохранение? Помогите ...
  • Как вставить Flash ролик в Delphi
    Как вставить Flash-ролик в Delphi? Установил ActiveX Shockwave Flash, но он не хочет проигрывать ролик...
  • COM порт
    Реально ли из своей проги читать данные с COM порта, с которым уже работает другая программа? Спасибо.
  • MIDAS. Как из приложения добавить запись в таблицу?
    Есть IBDataSet, DataSetProvider на сервере, ClientDataset и Datasource на клиенте. Как программно добавить запись с ...
  • Еще о KOLTabControl
    Господа! :) Еще один вопрос про KOLTabControl Допустим, есть две закладки. Кладем на первую что-нибудь. Я попробовал ...
  • Как сделать, чтобы окно приложения было поверх всех окон
    Привет всем! Как сделать, чтобы окно приложения было поверх всех окон? Такое свойство можно указывать в некоторых ...
  • Программа без VCL
    Доб день/вечер! Вот возникла такая проблема делаю прогру без VCL чисто хочу сделать трайикон+попменю к нему. Делаю это ...
У нас большой выбор статей   |x|
Пространство имён оболочки Windows
В операционных системах компании Microsoft с 1995 года используется новая оболочка, построенная на основе компонентной объектной модели.
Одним из нововведений оболочки операционной системы стало понятие пространства имён оболочки. Пространство имён оболочки являет собой иерархически упорядоченный мир объектов, известных операционной системе, с их свойствами и предоставляемыми действиями.
Оно во многом сходно со структурой файловой системы, но включает в себя не только файлы и каталоги. Такие понятия файловой системы, как имя файла и путь, заменены более универсальными.
Новинки книжного рынка   |x|
Экстремальное программирование: планирование. Библиотека программиста
Эта книга харизматических лидеров экстремального программирования — о том, как планировать проекты разработки программного обеспечения по технологии XP. В основном она предназначена руководителям — тем, кто должен составлять план работ, а потом следить, чтобы он соответствовал действительности. Она будет полезна и программистам с заказчиками, поскольку это две основные роли в процессе планирования и разработки ПО.
Автор: Kent Beck, Martin Fowler
Опрос населения :)
Стоит ли устраивать встречи программистов в реале? (пирушки :)
»»» Обязательно!
»»» Иногда можно
»»» Я туда не пойду
»»» Категорически нет
Для души

Хокку дня
Идущий по полю
Увядшему
Не видит поля.

Афоризмы
Кто знает - делает, а кто не знает - учит других....

Фраза дня
Горе ты моё аутлуковое!

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В городе Дюранго в Колорадо (США) считается преступлением появиться на улице в одежде, присущей другому полу.
В городе Лехай в Небраске (США) издано блестящее по идиотизму распоряжение, официально запрещающее продавать дырки от бубликов.

И на закуску коротенький анекдот
Американский "Боинг" и российское КБ "Сухой" объявили о совместном создании самолета "Бухой 747".

Фотоприколы.
Начните день с хорошего настроения!
http://www.delphimaster.ru/cgi-bin/prikol.pl?id=3589

На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (merlin@delphimaster.ru)

Добро пожаловать на сайт -= Мастера DELPHI =- 

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу

В избранное