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

📄 ufrmadclientmng.pas

📁 DAD2.0 上传下传DAD2.0 上传下传DAD2.0 上传下传DAD2.0 上传下传
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit ufrmADClientMng;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, StrUtils, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
  cxDataStorage, cxEdit, DB, cxDBData, cxGridCustomTableView,
  cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
  cxGridCustomView, cxGrid, cxGridViewData, ExtCtrls, dxmdaset, Clipbrd,
  Menus, ComCtrls;

type
  TfrmADClientMng = class(TForm)
    IdTCPClient1: TIdTCPClient;
    DataSource1: TDataSource;
    view: TcxGridDBTableView;
    level: TcxGridLevel;
    grid: TcxGrid;
    PopupMenu1: TPopupMenu;
    mnuSelectOrNotSelect: TMenuItem;
    mnuSetRuntimes: TMenuItem;
    N1: TMenuItem;
    MainMenu1: TMainMenu;
    N2: TMenuItem;
    mnuDownloadDB: TMenuItem;
    mnuEdit: TMenuItem;
    mnuAddIE_cpc: TMenuItem;
    mnuAddSearchGet: TMenuItem;
    N3: TMenuItem;
    mnuAddABCSearch: TMenuItem;
    Panel3: TPanel;
    cmbUser: TComboBox;
    Label8: TLabel;
    Label9: TLabel;

    mnuDelChina: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    mnuAddxmlfeed: TMenuItem;
    mnuDeleteRecord: TMenuItem;
    mnuAddiframe_cpc: TMenuItem;
    mnuDownReferer: TMenuItem;
    mnuCopyAccount: TMenuItem;
    N6: TMenuItem;
    mnuAccountMoveTo: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    txtLog: TMemo;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lblAHref: TLabel;
    lblImgsrc: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label10: TLabel;
    txtCountry: TEdit;
    txtRuntimes: TEdit;
    txtCTR: TEdit;
    txtAhref: TEdit;
    txtimgsrc: TEdit;
    txtKeywords2: TMemo;
    txtAdLink: TEdit;
    txtReferer: TEdit;
    txtUseIps: TEdit;
    cmdGetAccount: TButton;
    cmdAdd: TButton;
    cmdDel: TButton;
    cmdModify: TButton;
    subtype: TLabel;
    txtSubType: TEdit;
    txtType: TEdit;
    Label4: TLabel;
    IpRange: TLabel;
    txtIpRange: TEdit;
    Account: TLabel;
    txtAccount: TEdit;
    viewRecId: TcxGridDBColumn;
    viewfid: TcxGridDBColumn;
    viewshows: TcxGridDBColumn;
    viewhits: TcxGridDBColumn;
    viewzorder: TcxGridDBColumn;
    viewuser: TcxGridDBColumn;
    viewaccount: TcxGridDBColumn;
    viewftype: TcxGridDBColumn;
    viewadlink: TcxGridDBColumn;
    viewreferer: TcxGridDBColumn;
    viewkeywords2: TcxGridDBColumn;
    viewahref: TcxGridDBColumn;
    viewimgsrc: TcxGridDBColumn;
    viewctr: TcxGridDBColumn;
    viewthreads: TcxGridDBColumn;
    viewmemo: TcxGridDBColumn;
    viewruntimes: TcxGridDBColumn;
    viewisselected: TcxGridDBColumn;
    viewcountry: TcxGridDBColumn;
    viewowner: TcxGridDBColumn;
    viewuseips: TcxGridDBColumn;
    viewiprange: TcxGridDBColumn;
    viewneedlog: TcxGridDBColumn;
    viewisHits: TcxGridDBColumn;
    memDB: TdxMemData;
    memDBfid: TIntegerField;
    memDBshows: TIntegerField;
    memDBhits: TIntegerField;
    memDBzorder: TIntegerField;
    memDBuser: TStringField;
    memDBaccount: TStringField;
    memDBftype: TStringField;
    memDBadlink: TStringField;
    memDBreferer: TStringField;
    memDBkeywords2: TStringField;
    memDBahref: TStringField;
    memDBimgsrc: TStringField;
    memDBctr: TStringField;
    memDBthreads: TStringField;
    memDBmemo: TStringField;
    memDBruntimes: TStringField;
    memDBisselected: TStringField;
    memDBcountry: TStringField;
    memDBisHits: TStringField;
    memDBowner: TStringField;
    memDBuseips: TStringField;
    memDBiprange: TStringField;
    memDBneedlog: TStringField;
    lblCount: TLabel;
    txtCount: TEdit;
    sheetCheckTraffic: TTabSheet;
    txtResult: TMemo;
    cmdCheckTraffic: TButton;
    txt43906838: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    txt439068382: TEdit;
    txtxiaotm3: TEdit;
    Label5: TLabel;
    txtYuZhi: TEdit;
    cmdIPRange: TButton;
    txtSelectedCount: TEdit;
    procedure cmdGetAccountClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cmdAddClick(Sender: TObject);
    procedure cmdDelClick(Sender: TObject);
    procedure viewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure mnuSelectOrNotSelectClick(Sender: TObject);
    procedure mnuSetRuntimesClick(Sender: TObject);
    procedure cmdModifyClick(Sender: TObject);
    procedure mnuDownloadDBClick(Sender: TObject);
    procedure mnuEditClick(Sender: TObject);
    procedure viewFocusedRecordChanged(Sender: TcxCustomGridTableView;
      APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord;
      ANewItemRecordFocusingChanged: Boolean);
    procedure mnuAddIE_cpcClick(Sender: TObject);
    procedure mnuAddSearchGetClick(Sender: TObject);
    procedure mnuAddABCSearchClick(Sender: TObject);
    procedure cmbUserChange(Sender: TObject);
    procedure mnuDelChinaClick(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure mnuAddxmlfeedClick(Sender: TObject);
    procedure mnuDeleteRecordClick(Sender: TObject);
    procedure mnuAddiframe_cpcClick(Sender: TObject);
    procedure mnuDownRefererClick(Sender: TObject);
    procedure mnuCopyAccountClick(Sender: TObject);
    procedure mnuAccountMoveToClick(Sender: TObject);
    procedure cmdCheckTrafficClick(Sender: TObject);
    procedure cmdIPRangeClick(Sender: TObject);
  private
    { Private declarations }
    function DownloadAccount(var lstAccount: Tlist): boolean;
  public
    { Public declarations }
  end;

var
  frmADClientMng: TfrmADClientMng;

function GetRecord(user: string): Boolean;
function MyOneCharStringToBoolean(s: string): boolean;
function MyBooleanToOneCharString(b: boolean): string;

implementation

uses ufrmAdd, uMyTCPClient, uZip, uPlugCommon, uGlobalVar, ufrmAccounMoveTo;

{$R *.dfm}

function MyOneCharStringToBoolean(s: string): boolean;
begin
  result := false;
  if s = '1' then
  begin
    result := true;
  end;
end;

function MyBooleanToOneCharString(b: boolean): string;
begin
  result := '0';
  if b then
  begin
    result := '1';
  end;
end;

function GetValue(strLine: string): string;
var
  i: integer;
begin
  result := '';
  for i := 1 to length(strLine) - 1 do
  begin
    if strLine[i] = '=' then
    begin
      result := copy(strLine, i + 1, length(strLine) - i);
      exit;
    end;
  end;
end;

function GetName(strLine: string): string;
var
  i: integer;
begin
  result := '';
  for i := 1 to length(strLine) - 1 do
  begin
    if strLine[i] = '=' then
    begin
      result := copy(strLine, 1, i - 1);
      exit;
    end;
  end;
end;

function GetAccount(): string;
begin
  result := DoADServerCommand(ADSERVER_COMMAND_GET_ACCOUNT, CURRENT_USER);
end;

function DelAccount(strLine: string): string;
begin
  // ADSERVER_COMMAND_DEL_ACCOUNT
end;

function GetRecord(user: string): Boolean;
var
  strHead: string;
  nContextLength: Cardinal;
  nHeadLength: Cardinal;
  objIdTCPClient: TIdTCPClient;
  pzip: PChar;
  mso, mo: TmemoryStream;
  slAllProxy: TStringlist;
  i, nCount, nAllProxyCount,nSelectedCount,nIECount: integer;
  ftype :string;
begin
  screen.Cursor := crSQLWait;
  if user = 'all' then
  begin
     user := 'a" or 1=1 or "a"="a';
  end;
  result := false;
  objIdTCPClient := TIdTCPClient.Create(nil);
  mso := TmemoryStream.Create();
  mo := TmemoryStream.Create();

  pzip := nil;
  try
    try
      objIdTCPClient.Host := ADSERVER_IP;
      objIdTCPClient.Port := ADSERVER_PORT;

      objIdTCPClient.Connect(120000);

      strHead := user;
      nHeadLength := length(strHead);

      objIdTCPClient.WriteCardinal(ADSERVER_COMMAND, true);
      objIdTCPClient.WriteCardinal(ADSERVER_COMMAND_GET_ALL_RECORD, true);

      objIdTCPClient.WriteCardinal(nHeadLength, true);
      objIdTCPClient.WriteBuffer(strHead[1], length(strHead));

      sleep(100);
      nContextLength := objIdTCPClient.ReadInteger();
      if (nContextLength > 6000000) or (nContextLength < 0) then
      begin
        objIdTCPClient.Disconnect;
        exit;
      end;
      getMem(pzip, nContextLength);
      objIdTCPClient.ReadBuffer(pzip^, nContextLength);
      objIdTCPClient.Disconnect;

      mso.WriteBuffer(pzip^, nContextLength);
      mso.Position := 0;
      UNZIP(mso, mo);
      mo.Position := 0;

      frmADClientMng.memDB.LoadFromStream(mo);
      frmADClientMng.txtCount.Text := inttostr(frmADClientMng.memDB.RecordCount);



      frmADClientMng.memDB.DisableControls;
      frmADClientMng.memDB.First;
      nSelectedCount := 0;
      nIECount := 0;
      while not frmADClientMng.memDB.Eof do
      begin
       if frmADClientMng.memDB.FieldByName('isselected').AsString = '1' then
       begin
          nSelectedCount:= nSelectedCount +1;
          ftype  := frmADClientMng.memDB.FieldByName('ftype').AsString;
          if  pos('park',ftype) >0 then
          begin
            nIECount := nIECount + 1;
          end;
       end;
       frmADClientMng.memDB.Next;
      end;
      frmADClientMng.memDB.EnableControls ;
      frmADClientMng.txtSelectedCount.Text := 'TOTAL:'+inttostr(nSelectedCount) + '  PARK:' + inttostr(nIECount);


      result := true;
    except
      on e: Exception do
      begin
        frmADClientMng.txtLog.Lines.Add('GetRecord:' + ADSERVER_IP + ' ' + e.message);
      end;
    end;
  finally
    objIdTCPClient.Free;
    if (pzip <> nil) then FreeMem(pzip);
    mso.Free;
    mo.Free;
    screen.Cursor := crDefault;
  end;
end;

procedure TfrmADClientMng.cmdGetAccountClick(Sender: TObject);
begin
  if CURRENT_USER = '' then exit;
  GetRecord(CURRENT_USER);
end;

function TfrmADClientMng.DownloadAccount(var lstAccount: Tlist): boolean;
var
  pARecord: PAdsPackage;
  strAccountPackage, strLine: string;
  slLine, slField: TStringlist;
  i, j: integer;
begin
  strAccountPackage := GetAccount();
  if strAccountPackage = '' then exit;

  slLine := TStringlist.Create;
  slField := TStringlist.Create;
  try
    slLine.Text := AnsiReplaceStr(strAccountPackage, '$' + #13#10, #13#10);
    for i := 0 to slLine.Count - 1 do
    begin
      New(pARecord);
      zeromemory(pARecord, sizeof(TAdsPackage));
      pARecord.m_hMainWnd := self.Handle;
      pARecord.bClick := false;
      strLine := slLine[i];
      slField.Text := AnsiReplaceStr(strLine, '^;', #13#10);
      for j := 0 to slField.Count - 1 do
      begin
        if pos('user=', slField[j]) = 1 then pARecord.strUser := GetValue(slField[j]);
        if pos('account=', slField[j]) = 1 then pARecord.strAccount := GetValue(slField[j]);
        if pos('ftype=', slField[j]) = 1 then pARecord.strType := GetValue(slField[j]);
        if pos('adlink=', slField[j]) = 1 then pARecord.adLink := GetValue(slField[j]);
        if pos('referer=', slField[j]) = 1 then pARecord.strReferer := GetValue(slField[j]);
        if pos('imgsrc=', slField[j]) = 1 then pARecord.imgSrc := GetValue(slField[j]);
        if pos('ahref=', slField[j]) = 1 then pARecord.aHref := GetValue(slField[j]);
        if pos('keywords2=', slField[j]) = 1 then pARecord.keywords2 := GetValue(slField[j]);
        if pos('threads=', slField[j]) = 1 then pARecord.threads := StrToIntDef(GetValue(slField[j]), 1);
        if pos('memo=', slField[j]) = 1 then pARecord.memo := GetValue(slField[j]);
        if pos('ctr=', slField[j]) = 1 then pARecord.ctr := StrToIntDef(GetValue(slField[j]), 5);
        txtlog.Lines.Add(slField[j]);
      end;
      lstAccount.Add(pARecord);
    end;

  finally
    slLine.Free;
    slField.Free;
  end;

end;

procedure TfrmADClientMng.FormShow(Sender: TObject);
var
  i: integer;
begin
  cmbUser.ItemIndex := 0;
  if g_IsGaLa then
  begin
    cmbUser.Items.Clear;
    mnuDownloadDB.Visible := false;
    mnuAddIE_cpc.Visible := false;
  end;

  cmbUser.Items.Add('gala');
  cmbUser.Items.Add('gala_small');
  cmbUser.Items.Add('gala_fun');
  cmbUser.Items.Add('gala_abc');
  cmbUser.Items.Add('gala_xml');
  cmbUser.Items.Add('gala_ie');
  cmbUser.ItemIndex := 0;

  self.Caption := '广告设置(' + ADSERVER_IP + ':' + inttostr(ADSERVER_PORT) + ',' + CURRENT_USER + ')';

  cmbUserChange(sender);

end;

procedure TfrmADClientMng.cmdAddClick(Sender: TObject);
var
  frmAdd: TfrmAdd;
begin
  frmAdd := TfrmAdd.Create(self);
  frmAdd.m_bAdd := true;

  frmAdd.SelectedUser('ALL');
  frmAdd.txtUseips.Text := 'ALL';

  frmAdd.txtZOrder.Text := inttostr(5000 +random(4999));

  frmAdd.ShowModal;
  //  cmdGetAccountClick(sender);

end;

procedure TfrmADClientMng.cmdDelClick(Sender: TObject);
var
  strDeleteSQL: string;
  strResult: string;
  strfid: string;
  i, ARecordIndex: integer;
  rowinfo: TcxRowInfo;
  strReferer, strAccount, strUser: string;
begin

  strfid := memDB.FieldByName('fid').AsString;
  if windows.MessageBox(self.Handle, pchar('是否删除,编号=' + strfid), '提示信息', MB_YESNOCANCEL or MB_ICONWARNING or MB_DEFBUTTON3) <> ID_YES then
  begin
    exit;
  end;

  if strfid <> '' then
  begin
    strDeleteSQL := 'delete from account_tab where fid=' + strfid;
    strResult := DoADServerCommand(ADSERVER_COMMAND_EXECUTE_SQL, strDeleteSQL);
    if strResult = 'OK' then
    begin
      memDB.Delete;
    end;
    txtlog.Lines.Add(strResult);
  end;

end;

procedure TfrmADClientMng.viewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i: integer;
  s: string;
  obj: TClipboard;
begin
  if Shift = [ssCtrl] then
  begin
    if key = 67 then
    begin
      obj := TClipboard.Create;

      s := s + memDB.FieldByName('adlink').AsString + #13#10;
      s := s + memDB.FieldByName('referer').AsString + #13#10;
      s := s + memDB.FieldByName('keywords2').AsString + #13#10;

      obj.SetTextBuf(pchar(s));
      obj.Free;

    end;
  end;
end;

procedure TfrmADClientMng.mnuSelectOrNotSelectClick(Sender: TObject);
var
  nPos: integer;
  bOK: Boolean;
  strUpdate: string;
  isselected: string;
  strfid: string;
  strResult: string;
begin

  isselected := memDB.FieldByName('isselected').AsString;
  if isselected = '1' then
    isselected := '0'
  else
    isselected := '1';

  strfid := memDB.FieldByName('fid').AsString;

  strUpdate := 'update account_tab set isselected = "' + isselected + '" ';

⌨️ 快捷键说明

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