📄 ufrmadclientmng.pas
字号:
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 + -