| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Перенаправленный ввод-вывод

Страницы:   < 1 2 >

GanibalLector ©   (2006-01-17 02:36:00) 

Создаю сокет,перенаправляю ввод-вывод на cmd.exe. Захожу клиентом и юзаю cmd.exe из клиента. Так вот,проверяю сие творение на 2 компьютерах. На обном все Ок,а на втором cmd сразу закрывается. В чем может быть дело???
Открыват cmd.exe так :

sHandle := accept(FSocket, nil, nil);
   if sHandle <> INVALID_SOCKET then
    begin
      ZeroMemory(@St, SizeOf(TStartupInfo));
      St.cb := SizeOf(TStartupInfo);
      St.wShowWindow := SW_SHOW;
      St.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      St.hStdInput  := sHandle;
      St.hStdOutput := sHandle;
      St.hStdError  := sHandle;
      CreateProcess(nil, 'cmd.exe', nil, nil, true, 0, nil, nil, St, Pr);


---

GanibalLector   (2006-01-18 13:33:00) [21]

2 Digitman
Да,конечно.Вот клиент(черновой вариант!!!пока без синхронизации) :

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Start: TButton;
   Stop: TButton;
   Label1: TLabel;
   Edit1: TEdit;
   Exec_Console: TButton;
   procedure StopClick(Sender: TObject);
   procedure StartClick(Sender: TObject);
   procedure Exec_ConsoleClick(Sender: TObject);
 private
   B:Boolean;
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 StopThread,WrCons:Boolean;

const MAX_PACKET_SIZE = $10000;

implementation
 uses WinSock;
{$R *.dfm}

function Dos2Win(const aStr: String): String;
begin
  Result := aStr;
  if Result <> '' then
   OemToChar(PChar(Result),PChar(Result));
end;

function Win2Dos(const aStr: String): String;
begin
Result := aStr;
if Result <> '' then
  CharToOem(PChar(Result),PChar(Result));
end;

procedure Send_(Socket:TSocket;Data:String);
begin
 Data:=Win2Dos(Data);
 Send(Socket,Data[1],Length(Data),0);
end;

function Recv_(Socket:TSocket; var Data:String):Boolean;
 var Len,II:Integer;
     Packet: array[0..MAX_PACKET_SIZE - 1] of Byte;
begin
  Data:='';
  Len:=Recv(Socket,Packet,MAX_PACKET_SIZE,0);
  if Len>0 then
  begin
    for II:=0 to Len-1 do
     Data:=Data+Chr(Packet[II]); // от Лукавого.надо будет переделать
    Data:=Dos2Win(Data);
    Result:=True;
  end else Result:=False;
end;

function potok(Param:Pointer):DWord;
 var
   Sock:TSocket;
   Addr:TSockAddr;
   Data_:TWSAData;
   Data:String;
   FDSet:TFDSet;
   Tm:TTimeVal;
   ServStoped:Boolean;
begin
 StopThread:=True;
 WrCons:=False;
 ServStoped:=True;
 Result:=0;
 if WSAStartup($101,Data_)=0 then
 begin
   Sock:=Socket(AF_INET, SOCK_STREAM,0);
   if Sock<>INVALID_SOCKET then
   begin
     Addr.sin_family:=AF_Inet;
     Addr.sin_port:=HToNS(801);
     Addr.sin_addr.S_addr:=Inet_Addr('192.168.1.6');
     FillChar(Addr.Sin_Zero,SizeOf(Addr.Sin_Zero),0);
     if Connect(Sock,Addr,SizeOf(TSockAddr))<>SOCKET_ERROR then
     begin
       Form1.Memo1.Lines.Add('Нить запущена!');
       repeat
         FD_Zero(FDSet);    
         FD_Set(Sock,FDSet);
         Tm.tv_sec:=0;
         Tm.tv_usec:=10000;
         if Select(0,@FDSet,nil,nil,@Tm)<>0 then
         begin
           if FD_IsSet(Sock,FDSet) then
           begin
             if Recv_(Sock,Data) then
               Form1.Memo1.Lines.Add(Data)
               // выводим все полученное в Memo
               else
               ServStoped:=False; // сервер упал.выходим
           end;
         end;

         if WrCons then
         begin  // посылаем в консоль
           Send_(Sock,Form1.Edit1.Text+#13#10);
           WrCons:=False;
         end;

       until (not StopThread) or (not ServStoped);
       if not StopThread then
        Form1.Memo1.Lines.Add('Прервано пользователем') else
        Form1.Memo1.Lines.Add('Обрыв на сервере');
       CloseSocket(Sock);
       WSACleanup;
     end else
     begin  //
       Result:=WSAGetLastError;
       CloseSocket(Sock);
       WSACleanup;
     end;
   end else
   begin   //Socket
     Result:=WSAGetLastError;
     WSACleanup;
   end;
 end else Result:=WSAGetLastError; //WSAStartup
end;

procedure TForm1.StopClick(Sender: TObject);
begin
 StopThread:=False; // "убиваем" нить
 // для "убийства" можно использовать и CloseSocket
 // пока не определился какой вариант лучше
end;

procedure MsgWaitForSingleObject(Handle: THandle);
begin
repeat
  if MsgWaitForMultipleObjects(1, Handle, False, INFINITE, QS_ALLINPUT) = WAIT_OBJECT_0 + 1 then
   Application.ProcessMessages else
   Break;
until True = False;
end;

procedure TForm1.StartClick(Sender: TObject);
 var hThread:HWND;
   ThreadID,ECode:DWord;
begin
 if not(B) then
 begin
   B:=True;
   hThread:=BeginThread(nil,0,@potok,nil,0,ThreadID);
   MsgWaitForSingleObject(hThread);
   GetExitCodeThread(hThread,ECode);
   CloseHandle(hThread);
   if ECode<>0 then
     MessageDlg('Ошибка :'+SysErrorMessage(ECode),MtError,[MbOk],0);
   B:=False;
 end else
 MessageDlg('Нить УЖЕ работает!!! Хватит',MtError,[MbOk],0);
end;

procedure TForm1.Exec_ConsoleClick(Sender: TObject);
begin
 if Length(Edit1.Text)=0 then Exit;
 WrCons:=True;
end;

end.


Данный код у меня работает с разных Ос(98,ХР).Повторюсь сервер запускается на ХР SP1.
При коннекте клиентом на сервере запускается и "висит" cmd.exe до тех пор пока я не разорвусь клиентом.

З.Ы.При запуске сервера на SP2 (и дальнейшем коннекте клиентом) cmd.exe запускается и сразу же закрывается.Я все же  думаю,что беда в сервере. Вот,примерное такое происходит на сервере:


procedure TForm1.Button1Click(Sender: TObject);
 var
  St: TStartupInfo;
  Pr: TProcessInformation;
begin
  ZeroMemory(@St, SizeOf(TStartupInfo));
  St.cb := SizeOf(TStartupInfo);
  St.wShowWindow := SW_SHOW;
  St.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  St.hStdInput  := 0;   // это я специально,дабы показать
  St.hStdOutput := 0;
  St.hStdError  := 0;
  if not (CreateProcess(nil, 'cmd.exe', nil, nil, True, 0, nil, nil, St, Pr)) then
  MessageDlg('Ошибка:'+SysErrorMessage(GetLastError),MtError,[MbOk],0); // ошибки не будет
  CloseHandle(Pr.hProcess);
  CloseHandle(Pr.hThread);
end;


---

Digitman   (2006-01-18 08:36:00) [22]

Причем здесь конкретная функциональность твоего приложения ?
И причем здесь "сканеры" ?
Ты пытаешься управлять вводом-выводом некоего консольного приложения (в дан.случае - cmd.exe) посредством программных каналов. Вот я и хочу выяснить , какие конкретно данные и как ты посылаешь в канал ввода консоли ..

---

GanibalLector   (2006-01-18 01:44:00) [23]

2 PAVIA ©   (17.01.06 22:06) [3]
На одном XP SP2 - не работает.
На втором XP Sp1 - работает.

2 Digitman ©   (17.01.06 08:46) [1]
>Главное (обмен с cmd) осталось за кадром.
Не понял. Я могу в принципе и клиента своего выслать.Но ИМХО не стоит. Ибо любой сканер портов заменит моего клиента. Т.е. cmd.exe запустится,а в сканер портов скажет,что мол :Microsoft Windows XP и т.д.

---

PAVIA   (2006-01-17 22:06:00) [24]

GanibalLector
Какая ОС на компьютерах? А то для этого должна быть поддержка winsock 2.0 или 2.2

---

GanibalLector   (2006-01-17 19:56:00) [25]

2 Digitman
> почему нет анализа результата вызова CreateProcess
ф-ция выполнена успешно.

---

Digitman   (2006-01-17 08:46:00) [26]

Из приведенного фрагмента кода нельзя сделать никаких предположений.
Главное (обмен с cmd) осталось за кадром.
Кр.того, почему нет анализа результата вызова CreateProcess ?

---

Страницы:   < 1 2 >

Наверх