CommandLine

原创

mb64eeeb79969f2 2023-08-31 11:10:42 博主文章分类：CommandLine ©著作权

文章标签 buffer security integer string timer 文章分类 JavaScript 前端开发

©著作权归作者所有：来自51CTO博客作者mb64eeeb79969f2的原创作品，请联系作者获取转载授权，否则将追究法律责任

var
   Security: TSecurityAttributes;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
implementation
{$R *.dfm}
var
  ReadOut, WriteOut, ReadIn, WriteIn: Cardinal;
procedure InitConsole;
begin
  with Security do begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  Createpipe(ReadOut, WriteOut, @Security, 0);
  Createpipe(ReadIn, WriteIn, @Security, 0);
  with Security do begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  FillChar(Start, Sizeof(Start), #0);
  start.cb := SizeOf(start);
  start.hStdOutput := WriteOut;
  start.hStdInput := ReadIn;
  start.hStdError := WriteOut;
  start.dwFlags := STARTF_USESTDHANDLES +
    STARTF_USESHOWWINDOW;
  start.wShowWindow := SW_HIDE;
  CreateProcess(nil,
    PChar('cmd'),
    nil,          //@Security,
    nil,          //@Security,
    true,
    0,//NORMAL_PRIORITY_CLASS,
    nil,
    nil,
    start,
    ProcessInfo)
end;

function ReadFromPipe(Pipe: THandle): string;
var
  Buffer: PChar;
  BytesRead: DWord;
  ReadBuffer: Cardinal;
begin
  Result := '';
  if GetFileSize(Pipe, nil) = 0 then Exit;
  Buffer := AllocMem(ReadBuffer + 1);
  repeat
    BytesRead := 0;
    ReadFile(Pipe, Buffer[0],
      ReadBuffer, BytesRead, nil);
    if BytesRead > 0 then begin
      Buffer[BytesRead] := #0;
      OemToAnsi(Buffer, Buffer);
      Result := string(Buffer);
    end;
  until (BytesRead < ReadBuffer);
  FreeMem(Buffer);
end;

procedure WriteToPipe(Pipe: THandle; Value: string);
var
  len: integer;
  BytesWrite: DWord;
  Buffer: PChar;
begin
  len := Length(Value) + 1;
  Buffer := PChar(Value + #10);
  WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  s: string;
begin
  s := ReadFromPipe(ReadOut);
  if s <> '' then begin
    Form1.Mmo1.Lines.Text := Form1.Mmo1.Lines.Text + s;
    Form1.Mmo1.SelStart := length(Form1.Mmo1.Lines.Text);
    Form1.Mmo1.SelLength := 0
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Trim(cbb1.Text) <> '' then
  begin
    if UpperCase(cbb1.Text) = 'CLS' then
      mmo1.Clear
    else
      WriteToPipe(WriteIn, cbb1.Text);
    if cbb1.ItemIndex > -1 then
      cbb1.Items.Delete(cbb1.ItemIndex);
    cbb1.Items.Insert(0, Trim(cbb1.Text));
    cbb1.Text := '';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitConsole;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  if dlgOpen1.Execute then
    cbb1.Text := '"' + dlgOpen1.FileName + '"';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  ExitCode: Cardinal;
begin
  TerminateProcess(ProcessInfo.hProcess, ExitCode);
end;

procedure TForm1.cbb1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    if Trim(cbb1.Text) <> '' then
    begin
      if UpperCase(cbb1.Text) = 'CLS' then
        mmo1.Clear
      else
        WriteToPipe(WriteIn, cbb1.Text);
      if cbb1.ItemIndex > -1 then
        cbb1.Items.Delete(cbb1.ItemIndex);
      cbb1.Items.Insert(0, Trim(cbb1.Text));
      cbb1.Text := '';
    end;
end;