Форум: "Прочее";
Текущий архив: 2008.12.28;
Скачать: [xml.tar.bz2];

Вниз

Консоль для супер маленьких   Найти похожие ветки 

← →
koha!   (2008-10-26 23:22) [0]

Взял модуль, не помню чей, кажись, Игоря Шевченко и переделал, под самый минимум, и вот что получилось:

unit CmdConslAPI;

interface

Uses
 //SysUtils,
 Windows;

Type TCmdProc = (CP_NIL,CP_RESUME,CP_SUSPEND,CP_STOP);

Type
 PMsgRec = ^TMsgRec;
 TMsgRec = Record
   WND      : HWND;
   ThreadId : Cardinal;
   Msg      : Cardinal;
   ConslThrId : Cardinal;
   hThrConsl  : THandle;
End;

//WND,ThrId,Msg = response value
Function ConsoleCreate(WND: HWND; ThrId: Cardinal; Msg:Cardinal): boolean;
function ConsoleSendCommand(Cmd: String): Boolean;
procedure ConsoleThreadProc(P: Pointer);
function ConsoleResume: Boolean;
function ConsoleSuspend: Boolean;
function ConsoleStop: Boolean;

Var
 pi : TProcessInformation;
 ChildStdInWr  : THandle;
 ChildStdoutRd : THandle;
 CS_REC        : TRTLCriticalSection;
 MsgRec        : PMsgRec = Nil;
 CmdString     : String;
 CmdProc       : TCmdProc;
 ConslStat     : TCmdProc = CP_NIL;

implementation

{------------------------------- ConsoleCreate --------------------------------}
Function ConsoleCreate(WND: HWND; ThrId: Cardinal; Msg: Cardinal): boolean;
Var
ComSpec : String;
bufLen  : DWORD;
ChildStdoutWr, ChildStdInRd, Tmp1, Tmp2: THandle;
sa : TSecurityAttributes;
si : TStartupInfo;
begin
Result := false;

If Assigned(MsgRec) then Exit;
if (WND = 0) and (ThrId  = 0) then Exit;
if (WND = 0) and (Msg = 0) and (ThrId  = 0) Then Exit;

sa.nLength              := sizeof(TSecurityAttributes);
sa.bInheritHandle       := true;
sa.lpSecurityDescriptor := nil;

if not CreatePipe(ChildStdoutRd, ChildStdoutWr, @sa, 0) then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;
if not CreatePipe(ChildStdinRd, ChildStdinWr, @sa, 0) then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;

if not DuplicateHandle(GetCurrentProcess(),ChildStdoutRd,GetCurrentProcess(),@Tmp1,0,Fa lse,DUPLICATE_SAME_ACCESS) then
  begin
    //RaiseLastWin32Error;
    //PostThreadMessage(ThrId,Msg,0,GetLastError);
    //SendMessage(WND,Msg,0,GetLastError);
    exit;
  end;
if not DuplicateHandle(GetCurrentProcess(),ChildStdinWr,GetCurrentProcess(),@Tmp2,0,Fal se,DUPLICATE_SAME_ACCESS) then
  begin
    //RaiseLastWin32Error;
    //PostThreadMessage(ThrId,Msg,0,GetLastError);
    //SendMessage(WND,Msg,0,GetLastError);
    Exit;
  end;

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

bufLen := GetEnvironmentVariable("ComSpec",nil,0);
SetLength(ComSpec,bufLen);
GetEnvironmentVariable("ComSpec",@ComSpec[1],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 := SW_HIDE;
if not CreateProcess(nil,PChar(ComSpec),nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,si,pi) then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;

New(MsgRec);
ZeroMemory(MsgRec,SizeOf(TMsgRec));

MsgRec.WND       := WND;
MsgRec.ThreadId  := ThrId;
MsgRec.Msg       := Msg;
MsgRec.hThrConsl := BeginThread(Nil,0,Addr(ConsoleThreadProc),MsgRec,CREATE_SUSPENDED,MsgRec^.ConslT hrId);
if MsgRec.hThrConsl = 0 Then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;
ResumeThread(MsgRec.hThrConsl);
Result    := true;
ConslStat := CP_RESUME;
end;
{------------------------------ ConsoleSendCommand ----------------------------}
function ConsoleSendCommand(Cmd: String): Boolean;
begin
 if Not Assigned(MsgRec) Then Exit;
 EnterCriticalSection(CS_REC);
   CmdString:=CMD+#13#10;
 LeaveCriticalSection(CS_REC);
end;
{------------------------------- ConsoleThreadProc ----------------------------}
procedure ConsoleThreadProc(P: Pointer);
Var
buffer   : Pointer;
ByteRead : DWORD;
begin
 InitializeCriticalSection(CS_REC);
 try
 while WaitForSingleObject(PI.hProcess, 0) = WAIT_TIMEOUT do begin
   Sleep(50);
   PeekNamedPipe(ChildStdoutRd,nil,0,nil,@ByteRead,nil);

   if ByteRead > 0 then begin
     GetMem(buffer,ByteRead+1);
     try
       if not ReadFile(ChildStdoutRd,buffer^,ByteRead,ByteRead,nil) then begin
         //RaiseLastWin32Error;
         With PMsgRec(P)^ do begin
           PostThreadMessage(ThreadId,Msg,0,GetLastError);
           SendMessage(WND,Msg,0,GetLastError);
         end;
         Exit;
       end;
       PChar(buffer)[ByteRead]:=#0;
       With PMsgRec(P)^ do begin
         PostThreadMessage(ThreadId,Msg,Integer(PChar(buffer)),0);
         SendMessage(WND,Msg,Integer(PChar(buffer)),0);
       end;
     finally
       FreeMem(buffer);
     end;
   end;

   if CmdString <> "" then begin
     EnterCriticalSection(CS_REC);
     if not Windows.WriteFile(ChildStdinWr,CmdString[1],Length(CmdString),ByteRead,nil) then begin
       //RaiseLastWin32Error;
       With PMsgRec(P)^ do begin
         PostThreadMessage(ThreadId,Msg,0,GetLastError);
         SendMessage(WND,Msg,0,GetLastError);
       end;
       Exit;
     end;
     CmdString:="";
     LeaveCriticalSection(CS_REC);
   end;
 end;

 finally
   ConslStat:=CP_STOP;
   DeleteCriticalSection(CS_REC);
   CloseHandle(PI.hProcess);
   CloseHandle(PI.hThread);
   CloseHandle(PMsgRec(P).hThrConsl);
   Dispose(PMsgRec(p));
   MsgRec := Nil;
 end;
end;
{--------------------------------- ConsoleResume ------------------------------}
function ConsoleResume: Boolean;
begin
 Result:=false;
 if Not Assigned(MsgRec) Then Exit;
 if ResumeThread(PI.hThread) = -1 then Exit;
 ConslStat := CP_RESUME;
 Result := true;
end;
{-------------------------------- ConsoleSuspend ------------------------------}
function ConsoleSuspend: Boolean;
begin
 Result:=false;
 if Not Assigned(MsgRec) or (ConslStat = CP_SUSPEND) Then Exit;
 if SuspendThread(PI.hThread) = -1 then Exit;
 ConslStat := CP_SUSPEND;
 Result    := true;
end;
{---------------------------------- ConsoleStop -------------------------------}
function ConsoleStop: Boolean;
begin
 Result:=false;
 if Not Assigned(MsgRec) then Exit;
 if Not TerminateProcess(PI.hProcess,0) then Exit;
 ConslStat := CP_STOP;
 Result    := true;
end;

end.

---

← →
Кто б сомневался ©   (2008-10-27 00:56) [1]

C целью уменьшения размера? Тогда тебе в KOL.

---

← →
Virgo_Style ©   (2008-10-27 09:37) [2]

Переделанное - это закомментированное?

...помню, в детстве собирал я усилитель. Взял схемку, посмотрел. Резисторы, транзисторы, батарейка. Так, а зачем батарейка-то? Он же и так - УСИЛИТЕЛЬ! Лишняя деталь, явно лишняя.

Ну и... оптимизировал.

Но почему-то не заработало.

---

← →
www   (2008-10-27 10:56) [3]

лень вчитываться
чево делает-то?

---

← →
koha!   (2008-10-27 11:02) [4]

> Virgo_Style ©   (27.10.08 09:37) [2]
>
> Переделанное - это закомментированное?


Да нет же модуль ранее выглядел то по другому, он был в классом оформлен TThrea, а теперь просто работает без классов и без жрущих объем модулей Classes, SysUtils, теперь только используется модуль windows.  Ну что есть разница? А закомментировал, потому, что мне пока обработка ошибок не требовалась, а если кому требуется, можно убрать кометарии на SysUtils  в Uses и на //RaiseLastWin32Error;

Вот он в оригинале ка выглядел:

unit CmdConsole;

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);
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;
  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
  RaiseLastWin32Error;
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:=SW_HIDE;
if not CreateProcess(nil,comSpec,nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,si,pi) then
  RaiseLastWin32Error;
end;
end.

---

← →
speller   (2008-10-27 11:58) [5]

всё-равно всё в архиве будет :))

---

← →
www   (2008-10-27 13:16) [6]

> всё-равно всё в архиве будет :))

потрепаловка не архивируется, имнип

---

← →
koha!   (2008-10-27 13:36) [7]

> www   (27.10.08 13:16) [6]
> > всё-равно всё в архиве будет :))потрепаловка не архивируется,
>  имнип


если не архивируется, значит в будущем претендую на экслюзивный модуль :-)

---

← →
speller   (2008-10-28 01:07) [8]

> потрепаловка не архивируется

если посмотреть вниз, то можно увидеть ссылку "А здесь вы найдете архивы старых форумов". А еще можно посмотреть на последнюю страницу и на дату самого старого топика в разделе. Чтобы освежить память )

---

Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2008.12.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.046 c