请问个屏幕字符获取的问题

Question

大家好：  目前有一个类似dos的黑屏幕在跑，我不能控制它。但我想做一个程序，通过一个窗口来实时显示黑屏幕上出现的字符，请问有什么方案？  多谢

Answer 1

http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=199752管道的例子：  
unit  Unit1;  
 
interface  
 
uses  
   Windows,  Messages,  SysUtils,  Variants,  Classes,  Graphics,  Controls,  Forms,  
   Dialogs,  StdCtrls;  
 
type  
   TPipeForm  =  class(TForm)  
       Editor:  TMemo;  
       procedure  EditorKeyPress(Sender:  TObject;  var  Key:  Char);  
       procedure  FormDestroy(Sender:  TObject);  
       procedure  FormCreate(Sender:  TObject);  
       procedure  EditorKeyDown(Sender:  TObject;  var  Key:  Word;  
           Shift:  TShiftState);  
       procedure  EditorMouseDown(Sender:  TObject;  Button:  TMouseButton;  
           Shift:  TShiftState;  X,  Y:  Integer);  
   private  
       {  Private  declarations  }  
       CreateOk:  Boolean;  
                       WPos:  TPoint;  
       hReadPipe,  hWritePipe,  hWriteFile,  hReadFile:  THandle;  
       processinfo:  PROCESS_INFORMATION;  
       procedure  SendCmdToShell(Const  CmdStr:  String);  
       function  GetCmdStr:  string;  
   public  
       {  Public  declarations  }  
   end;  
 
var  
   PipeForm:  TPipeForm;  
 
implementation  
 
{$R  *.dfm}  
 
procedure  TPipeForm.EditorKeyPress(Sender:  TObject;  var  Key:  Char);  
var  
   ECharPos:  TPoint;  
begin  
           if  Key  =  Chr(VK_RETURN)  then  
   begin  
//        ShowMessage(GetCmdStr);  
                       SendCmdToShell(GetCmdStr);  
   end  else  if  Key  =  Chr(VK_BACK)  then  
   begin  
               ECharPos  :=  Editor.CaretPos;  
               if  ECharPos.X  =  WPos.X  +  1  then  
                   Key  :=  #0;  
   end;  
end;  
 
procedure  TPipeForm.SendCmdToShell(Const  CmdStr:  String);  
var  
           ShellCmdStr:  array[0..256]  of  char;  
   RBuffer:  array[0..25000]  of  char;  
   nByteToWrite:  DWORD;  
   nByteWritten:  DWORD;  
   nByteReaden:  DWORD;  
begin  
           if  CreateOK  then  
   begin  
       StrPCopy(ShellCmdStr,  CmdStr);  
       nByteToWrite  :=  StrLen(ShellCmdStr);  
       ShellCmdStr[nByteToWrite]  :=  #13;  
       ShellCmdStr[nByteToWrite+1]  :=  #10;  
                       ShellCmdStr[nByteToWrite+2]  :=  #0;  
       Inc(nByteToWrite,  2);  
       WriteFile(hWriteFile,  ShellCmdStr,  nByteToWrite,  nByteWritten,  nil);  
       Sleep(400);  
       Editor.Lines.Clear;  
       FillChar(RBuffer,  Sizeof(RBuffer),  #0);  
       ReadFile(hReadFile,  RBuffer,  25000,  nByteReaden,  nil);  
       Editor.Lines.Add(StrPas(RBuffer));  
       WPos.Y  :=  Editor.Lines.Count-1;  
       WPos.X  :=  Length(Editor.Lines[WPos.Y])-1;  
   end;  
end;  
 
procedure  TPipeForm.FormDestroy(Sender:  TObject);  
var  
           shellexitcode:  Cardinal;  
begin  
           if  GetExitCodeProcess(processinfo.hProcess,  shellexitcode)  then  
   begin  
               if  shellexitcode  =  STILL_ACTIVE  then  
                                   TerminateProcess(processinfo.hProcess,  0);  
   end;  
   if  hWriteFile  <>  0  then  
               CloseHandle(hWriteFile);  
   if  hReadFile  <>  0  then  
               CloseHandle(hReadFile);  
end;  
 
procedure  TPipeForm.FormCreate(Sender:  TObject);  
var  
           Pipeattr:  SECURITY_ATTRIBUTES;  
   ShellStartInfo:  STARTUPINFO;  
   shellstr:  array  [0..256]  of  char;  
   RBuffer:  array[0..25000]  of  char;  
   I:  Integer;  
   nByteReaden:  DWORD;  
begin  
           CreateOK  :=  False;  
   I  :=  0;  
   Editor.ReadOnly  :=  False;  
   Wpos.X  :=  0;  
   WPos.Y  :=  0;  
   with  Pipeattr  do  
   begin  
                       nLength  :=  Sizeof(SECURITY_ATTRIBUTES);  
                       lpSecurityDescriptor  :=  nil;  
                       bInheritHandle  :=  true;  
   end;  
 
           if  CreatePipe(hReadPipe,  hWriteFile,  @Pipeattr,  0)  then  
               Inc(i);  
           if  CreatePipe(hReadFile,  hWritePipe,  @pipeattr,  0)  then  
               Inc(i);  
 
   GetStartupInfo(ShellStartInfo);  
   with  ShellStartInfo  do  
   begin  
       dwFlags  :=  STARTF_USESHOWWINDOW  or  STARTF_USESTDHANDLES;  
       hStdInput  :=  hReadPipe;  
       hStdError  :=  hWritePipe;  
       hStdOutput  :=  hWritePipe;  
       wShowWindow  :=  SW_HIDE;  
   end;  
           GetSystemDirectory(@Shellstr,  MAX_PATH+1);  
   StrCat(@ShellStr,  Pchar('\\cmd.exe'));  
   if  CreateProcess(Shellstr,  nil,  nil,  nil,  True,  0,  
                                                                                   nil,  nil,  ShellStartInfo,  processinfo)  then  
           begin  
       Inc(i);  
   end  else  begin  
               MessageBox(Handle,  Pchar('调用Shell错误！'),  Pchar('错误'),  (MB_OK  or  MB_ICONERROR));  
           end;  
   if  i  =  3  then  
   begin  
               CreateOK  :=  True;  
       Editor.Lines.Clear;  
       sleep(250);  
                       ReadFile(hReadFile,  RBuffer,  25000,  nByteReaden,  nil);  
               Editor.Lines.Add(StrPas(RBuffer));  
                       WPos.Y  :=  Editor.Lines.Count-1;  
       WPos.X  :=  Length(Editor.Lines[WPos.Y])-1;  
   end;  
end;  
 
procedure  TPipeForm.EditorKeyDown(Sender:  TObject;  var  Key:  Word;  
   Shift:  TShiftState);  
var  
   ECharPos:  TPoint;  
begin  
   ECharPos  :=  Editor.CaretPos;  
   if  ECharPos.Y  >  WPos.Y  then  
               Editor.ReadOnly  :=  False  
   else  if  (ECharPos.Y  =  WPos.Y)  and  (ECharPos.X  >  WPos.X)  then  
   begin  
               Editor.ReadOnly  :=  False;  
   end  else  
               Editor.ReadOnly  :=  True;  
end;  
 
function  TPipeForm.GetCmdStr:  string;  
var  
           LastLine:  Integer;  
begin  
           LastLine  :=  Editor.Lines.Count  -  1;  
   if  LastLine  >  WPos.Y  then  
   begin  
                       result  :=  Editor.Lines[LastLine];  
   end  else  if  LastLine  =  WPos.Y  then  
   begin  
               result  :=  Editor.Lines[LastLine];  
       result  :=  Copy(result,  WPos.X+2,  Length(result));  
   end  else  
   begin  
               result  :=  '  ';  
   end;  
end;  
 
procedure  TPipeForm.EditorMouseDown(Sender:  TObject;  Button:  TMouseButton;  
   Shift:  TShiftState;  X,  Y:  Integer);  
var  
   ECharPos:  TPoint;  
begin  
   ECharPos  :=  Editor.CaretPos;  
   if  ECharPos.Y  >  WPos.Y  then  
               Editor.ReadOnly  :=  False  
   else  if  (ECharPos.Y  =  WPos.Y)  and  (ECharPos.X  >  WPos.X)  then  
               Editor.ReadOnly  :=  False  
   else  
               Editor.ReadOnly  :=  True;  
end;  
 
end.

Answer 2

多谢2位的热心。现在还有一个问题啊，另外一个程序是一直在跑的，不是通过我的程序来调用shell启动的，我怎么监控到呢？

Answer 3

这么说吧，举个例子。我首先用 cmd命令启动一个黑屏幕出来，然后我可以在里面敲入 dir ，ping ，等命令，在黑屏幕上会有相应的显示，我希望能在我的屏幕上面也显示相同的内容，请问怎么办？当然，这个黑屏幕也可以通过shell来启动，但会有交互产生，产生后的内容怎么显示？