unitmain.pas

不错的远程控制程序

  NotifyLoop: Integer;
  NotifyProcedure: TNotifySocketEvent;
  Address: string;
begin
  if CommandFrame.Command = R_ADDRESS then
  begin
    SetLength(Address, Stream.Size);
    Stream.ReadBuffer(Pointer(Address)^, Stream.Size);
    TStreamRecord(Socket.Data).LocalAddress := Socket.RemoteAddress + ':' + Address;
    if Main.NotifyConnectList.Count = 0 then Exit;
    for NotifyLoop := 0 to Main.NotifyConnectList.Count - 1 do
    begin
      Application.ProcessMessages;
      if NotifyLoop >= Main.NotifyConnectList.Count then Exit;
      @NotifyProcedure := TNotifyInfo(Main.NotifyConnectList.Items[NotifyLoop]).Callback;
      try
        if Assigned(NotifyProcedure) then NotifyProcedure(Socket, TNotifyInfo(Main.NotifyConnectList.Items[NotifyLoop]).Data);
      except
      end;
      if Socket = nil then Break;
    end;
    Socket := nil;
  end;
end;

procedure TMain.Read(var Socket: TCustomWinSocket; CommandFrame: TCommandFrame; Stream: TMemoryStream; Data: Pointer);
var
  Main: TMain;
  Info: TComputerInfo;
  Time: string;
  Address,Name,OS: string;
begin
  Main := TMain(Data);
  if Main.Clients.IndexOf(Socket) <> -1 then
  begin
    case CommandFrame.Command of
      M_INFO:
        begin
          if not Assigned(TStreamRecord(Socket.Data).ListItem) then
          begin
            Stream.ReadBuffer(Info, SizeOf(TComputerInfo));
            TStreamRecord(Socket.Data).Info := Info;
            TStreamRecord(Socket.Data).ListItem := Main.ListView1.Items.Add;
            LastItem := TStreamRecord(Socket.Data).ListItem;
            ItemDelay := 200;
            Main.Timer3.Enabled := True;
            TStreamRecord(Socket.Data).ListItem.Data := Socket;
            TStreamRecord(Socket.Data).ListItem.Caption := Main.GetIPtoAdder(Socket.RemoteAddress) + '-' + Socket.RemoteAddress;
            ShowColumnInfo(Main);
              Address := Socket.RemoteAddress;
              Name := TStreamRecord(Socket.Data).Info.ComputerName;
              case TStreamRecord(Socket.Data).Info.OS of
                0: OS := '未知';
                4: OS := 'Windows NT';
                5: OS := 'Win2000';
                6: OS := 'WinXP';
                7: OS := 'Win2003';
              end;
            Time:=DateTimeToStr(Now);
            Main. CmdRichEdit.Lines.Add(Time+' '+'主机:'+Main.GetIPtoAdder(Address)+'-'+Address+'('+OS+')'+' 上线了!');
            Main.StatusBar1.Panels.Items[1].Text := '在线主机: ' + IntToStr(Main.ListView1.Items.Count);
          end;
        end;
    end;
    Socket := nil;
  end;
end;

procedure TMain.Disconnect(var Socket: TCustomWinSocket; Data: Pointer);
var
  Main: TMain;
begin
  Main := TMain(Data);
  if Main.Clients.IndexOf(Socket) <> -1 then
  begin
    if Assigned(TStreamRecord(Socket.Data).ListItem) then TStreamRecord(Socket.Data).ListItem.Delete;
    Main.Clients.Delete(Main.Clients.IndexOf(Socket));
    ListView1.Clear;
    Main.StatusBar1.Panels.Items[1].Text := ' 在线: ' + IntToStr(Main.ListView1.Items.Count);
    Socket := nil;
  end;
end;

function TMain.GetStream(var Socket: TCustomWinSocket): Boolean;
var
  BytesRead, DataAvailable, DataInStream: Int64;
  Buffer: array[0..4095] of Char;
  StreamRecord: TStreamRecord;
begin
  Result := False;
  if Socket = nil then Exit;
  StreamRecord := TStreamRecord(Socket.Data);
  DataAvailable := Socket.ReceiveLength;
  if not StreamRecord.ReceivingStream then
  begin
    if DataAvailable < SizeOf(TStreamFrame) then Exit;
    BytesRead := Socket.ReceiveBuf(StreamRecord.StreamFrame, SizeOf(TStreamFrame));
    if ((BytesRead = SizeOf(TStreamFrame)) and (StreamRecord.StreamFrame.ID = FRAME_ID)) then
    begin
      StreamRecord.Stream.Position := 0;
      StreamRecord.Stream.Size := StreamRecord.StreamFrame.len;
      if StreamRecord.Stream.Size = StreamRecord.StreamFrame.len then
      begin
        StreamRecord.ReceivingStream := True;
        StreamRecord.ProgressBar := TProgressBar.Create(Transfers.ListView1);
        StreamRecord.ProgressBar.Top := Transfers.Height + 1;
        StreamRecord.ProgressBar.Parent := Transfers.ListView1;
        StreamRecord.ProgressBar.Smooth := True;
        StreamRecord.ProgressBar.Min := 0;
        StreamRecord.ProgressBar.Max := 100;
        StreamRecord.ProgressBar.Position := 0;
        StreamRecord.ProgressBar.Visible := False;
        StreamRecord.StreamListItem := Transfers.ListView1.Items.Add;
        StreamRecord.StreamListItem.Data := StreamRecord;
        StreamRecord.StreamListItem.Caption := Socket.RemoteAddress;
        StreamRecord.StreamListItem.SubItems.Add(IntToStr(Socket.RemotePort));
        StreamRecord.StreamListItem.SubItems.Add(IntToStr(StreamRecord.Stream.Size));
        StreamRecord.StreamListItem.SubItems.Add(Copy(FloatToStr(StreamRecord.StreamFrame.Rate), 1, 4) + '%');
        Transfers.ListView1.Invalidate;
      end;
    end
    else
    begin
      Socket.Close;
      Socket := nil;
    end;
  end
  else
  begin
    if StreamRecord.TotalBytesRead >= Int64(StreamRecord.StreamFrame.len) then
    begin
      StreamRecord.Stream.Position := 0;
      StreamRecord.ReceivingStream := False;
      StreamRecord.TotalBytesRead := 0;
      StreamRecord.ProgressBar.Free;
      StreamRecord.ProgressBar := nil;
      StreamRecord.StreamListItem.Delete;
      StreamRecord.StreamListItem := nil;
      Result := True;
      Exit;
    end
    else if StreamRecord.StreamFrame.len > 0 then
    begin
      if (Int64(StreamRecord.StreamFrame.len) - StreamRecord.TotalBytesRead) < SizeOf(Buffer) then
        DataInStream := Int64(StreamRecord.StreamFrame.len) - StreamRecord.TotalBytesRead
      else
        DataInStream := SizeOf(Buffer);
      BytesRead := Socket.ReceiveBuf(Buffer, DataInStream);
      if BytesRead > 0 then
      begin
        StreamRecord.Stream.WriteBuffer(Buffer, BytesRead);
        StreamRecord.TotalBytesRead := StreamRecord.TotalBytesRead + BytesRead;
        StreamRecord.ProgressBar.Position := ((StreamRecord.StreamFrame.len * 100) div StreamRecord.TotalBytesRead);
        StreamRecord.ProgressBar.Repaint;
      end;
      if StreamRecord.TotalBytesRead >= Int64(StreamRecord.StreamFrame.len) then
      begin
        StreamRecord.Stream.Position := 0;
        StreamRecord.ReceivingStream := False;
        StreamRecord.TotalBytesRead := 0;
        StreamRecord.ProgressBar.Free;
        StreamRecord.ProgressBar := nil;
        StreamRecord.StreamListItem.Delete;
        StreamRecord.StreamListItem := nil;
        Result := True;
        Exit;
      end;
    end
    else
    begin
      Socket.Close;
      Socket := nil;
    end;
  end;
end;

function TMain.SendStream(Socket: TCustomWinSocket; Stream: TMemoryStream): Boolean;
var
  Frame: TStreamFrame;
  InputStream, OutputStream: TMemoryStream;
  CompressionStream: TCompressionStream;
  Rate: Single;
  StreamRecord: TStreamRecord;
begin
  Result := False;
  if not Assigned(Socket) then Exit;
  InputStream := Stream;
  InputStream.Position := 0;
  OutputStream := TMemoryStream.Create;
  CompressionStream := TCompressionStream.Create(OutputStream, zcMax);
  CompressionStream.CopyFrom(InputStream, InputStream.Size);
  Rate := CompressionStream.CompressionRate;
  CompressionStream.Free;
  Frame.len := OutputStream.Size;
  Frame.ID := FRAME_ID;
  OutputStream.Position := 0;
  while ((Socket.Connected) and (Socket.SendBuf(Frame, SizeOf(TStreamFrame)) = -1)) do Sleep(1);
  if not Socket.Connected then Exit;
  StreamRecord := TStreamRecord(Socket.Data);
  StreamRecord.SendProgressBar := TProgressBar.Create(Transfers.ListView1);
  StreamRecord.SendProgressBar.Top := Transfers.Height + 1;
  StreamRecord.SendProgressBar.Parent := Transfers.ListView1;
  StreamRecord.SendProgressBar.Smooth := True;
  StreamRecord.SendProgressBar.Min := 0;
  StreamRecord.SendProgressBar.Max := Stream.Size;
  StreamRecord.SendProgressBar.Position := 0;
  StreamRecord.SendProgressBar.Visible := False;
  StreamRecord.SendStreamListItem := Transfers.ListView1.Items.Add;
  StreamRecord.SendStreamListItem.Data := StreamRecord;
  StreamRecord.SendStreamListItem.Caption := Socket.RemoteAddress;
  StreamRecord.SendStreamListItem.SubItems.Add(IntToStr(Socket.RemotePort));
  StreamRecord.SendStreamListItem.SubItems.Add(IntToStr(Stream.Size));
  StreamRecord.SendStreamListItem.SubItems.Add(Copy(FloatToStr(Rate), 1, 4) + '%');
  repeat
    Application.ProcessMessages;
    Result := Socket.SendStream(Sockets.TStream(OutputStream));
  until Result or not Socket.Connected;
  InputStream.Free;
end;

procedure GetLocalIP;
type
  TaPInAddr = array[0..255] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  i: integer;
  GInitData: TWSADATA;
  Temp: string;
begin
  wsastartup($101, GInitData);
  Temp := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if not assigned(phe) then
    exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  i := 0;
  while pptr^[I] <> nil do begin
    Temp := Temp + StrPas(inet_ntoa(pptr^[I]^)) + ',';
    inc(i);
  end;
  Delete(Temp, Length(Temp), 1);
  try
    Main.Caption := ('飞讯 V1.0 作者:风蓝 QQ:4560338') + '    ' + Temp; 
  except
  end;
  wsacleanup;
end;

procedure TMain.FormCreate(Sender: TObject);
var
  NotifyInfo: TNotifyInfo;
//  MainKey, RegKey: HKey;
//  Value, ValueLen, Yes: dword;
//  Column: TListColumn;
//  ListLoop: Integer;
//  Columns: string;
begin
  LoadINIFile;

  Transfers := TTransfers.Create(Application);
  Window := TWindow.Create(Application);
  SystrayIcon := TSystray.Create(nil);
  SystrayIcon.Visible := True;
  Timer2.Enabled := True;
  SystrayIcon.Icon := Icon;
  SystrayIcon.OnDblClick := Systray1Click;
  NotifyConnectList := TList.Create;
  NotifyReadList := TList.Create;
  NotifyDisconnectList := TList.Create;
  Clients := TList.Create;
  ServerSocket := TServerSocket.Create;
  ServerSocket.OnClientConnect := ClientConnect;
  ServerSocket.OnClientRead := ClientRead;
  ServerSocket.OnClientDisconnect := ClientDisconnect;

  NotifyInfo := TNotifyInfo.Create;
  NotifyInfo.Data := Self;
  NotifyInfo.Callback := @TMain.Connect;
  NotifyConnectList.Add(NotifyInfo);
  NotifyInfo := TNotifyInfo.Create;
  NotifyInfo.Data := Self;
  NotifyInfo.Callback := @TMain.RawRead;
  NotifyReadList.Add(NotifyInfo);
  NotifyInfo := TNotifyInfo.Create;
  NotifyInfo.Data := Self;
  NotifyInfo.Callback := @TMain.Read;
  NotifyReadList.Add(NotifyInfo);
  NotifyInfo := TNotifyInfo.Create;
  NotifyInfo.Data := Self;
  NotifyInfo.Callback := @TMain.Disconnect;
  NotifyDisconnectList.Add(NotifyInfo);
  Timer1.Enabled := True;


  GetLocalIP;
  IPCreate;


  IPFile := ExtractFilePath(Paramstr(0)) + 'QQWry.Dat';
  QQWry := TQQWry.Create(IPFile);
end;

procedure TMain.ClientConnect(Sender: TObject; ClientSocket: TCustomWinSocket);
var
  StreamRecord: TStreamRecord;
begin
  StreamRecord := TStreamRecord.Create;
  StreamRecord.Stream := TMemoryStream.Create;
  StreamRecord.ReceivingStream := False;
  ClientSocket.Data := Pointer(StreamRecord);
end;

procedure TMain.ClientRead(Sender: TObject; ClientSocket: TCustomWinSocket);
var
  NotifyLoop: Integer;
  NotifyProcedure: TNotifySocketFrameEvent;
  Socket: TCustomWinSocket;
  OutputStream: TMemoryStream;
  DecompressionStream: TDecompressionStream;
  Position: dword;
  Frame: TCommandFrame;
  FrameStream: TMemoryStream;
begin
  Socket := ClientSocket;
  if NotifyReadList.Count = 0 then Exit;
  if ((GetStream(Socket)) and (Socket <> nil)) then
  begin
    Application.ProcessMessages;
    OutputStream := TMemoryStream.Create;
    DecompressionStream := TDecompressionStream.Create(TStreamRecord(Socket.Data).Stream);
    OutputStream.CopyFrom(DecompressionStream, 0);
    DecompressionStream.Free;
    Position := 0;
    while ((Position < OutputStream.Size) and (ClientSocket.Connected)) do
    begin
      Application.ProcessMessages;
      Socket := ClientSocket;
      OutputStream.Position := Position;
      OutputStream.ReadBuffer(Frame, SizeOf(TCommandFrame));
      FrameStream := TMemoryStream.Create;
      if Frame.len <> 0 then
        FrameStream.CopyFrom(OutputStream, Frame.len);
      FrameStream.Position := 0;
      for NotifyLoop := 0 to NotifyReadList.Count - 1 do
      begin
        Application.ProcessMessages;
        if NotifyLoop >= NotifyReadList.Count then Exit;
        if Socket <> nil then
        begin
          @NotifyProcedure := TNotifyInfo(NotifyReadList.Items[NotifyLoop]).Callback;
          try
            if Assigned(NotifyProcedure) then NotifyProcedure(Socket, Frame, FrameStream, TNotifyInfo(NotifyReadList.Items[NotifyLoop]).Data);
          except
          end;
        end;
      end;
      Inc(Position, SizeOf(TCommandFrame));
      Inc(Position, Frame.len);
      FrameStream.Free;
      if Socket <> nil then
      begin
        Socket.Close;
        Socket := nil;
        Break;
      end;
    end;
    OutputStream.Free;
  end;
end;

procedure TMain.ClientDisconnect(Sender: TObject; ClientSocket: TCustomWinSocket);
var
  NotifyLoop: Integer;
  NotifyProcedure: TNotifySocketEvent;
  Socket: TCustomWinSocket;
  StreamRecord: TStreamRecord;
begin
  Socket := ClientSocket;
  if NotifyDisconnectList.Count = 0 then Exit;
  for NotifyLoop := 0 to NotifyDisconnectList.Count - 1 do
  begin
    Application.ProcessMessages;
    if NotifyLoop >= NotifyDisconnectList.Count then Exit;
    @NotifyProcedure := TNotifyInfo(NotifyDisconnectList.Items[NotifyLoop]).Callback;
    try
      if Assigned(NotifyProcedure) then NotifyProcedure(Socket, TNotifyInfo(NotifyDisconnectList.Items[NotifyLoop]).Data);
    except
    end;
    if Socket = nil then Break;
  end;
  StreamRecord := TStreamRecord(ClientSocket.Data);
  StreamRecord.Stream.Free;