Создание Delphi приложения. Модуль: "Проверка Тиц, Pr, ЯР"

С данного поста, я начинаю серию обучающих уроков по описанию разработки SEO инструментов в Delphi своими руками.

Тема SEO очень обширная, и актуальная на сегодняшний день, данные программы пользуються популярностью, приносят доход, и поэтому найти исходники данных программ в рунете практически невозможно. Множество функций сейчас перенесено в web-интерфейс, но остались те, кто ассоциируют продвижение сайта с некоторой программой. И поверьте их не мало. Кто знает, может быть именно ваша программа завоюет сердца миллионов, но если не миллионов то сотни тысяч человек. Готовы? Тогда начнём!

Цели:

В сегодняшнем уроке мы создадим новое Delphi-приложение.
Напишем наш первый модуль для Проверки Тиц, Pr, ЯР.

Шаг 1. Первое с чего начнём, это с красивой оболочки нашей программы, для меня как и для многих пользователей, карасивый как и удобный интерфейс является основным критерием отбора среди других программ такого рода. Для этого Вам необходимо:

Скачать AlphaControls для Delphi 7;
Установить.

Шаг 2. Создать новое приложение, настроить форму и стиль под себя. Создать на форме кнопку нашего первого модуля "Массовая проверка тИЦ и Pr". Должно получиться нечто похожее как на рис. 1

рис. 1 Главная форма

Шаг 3. Создадим ещё одну форму. Советую называть формы вам удобными именами, нежели Form 1..N. Продолжим. Расположим на форме следующие компоненты (рис. 3). Должно получиться примерно вот так (рис. 4).

рис. 3 Компоненты модуля проверки рис. 4 Визуальное расположение компонентов на форме.

Шаг 4. Функция Проверки Тиц, Pr, ЯР на Delphi.

Код:

function Check_PR(aUrl: string): string; //Проверка Google Page Rank
  const
  seed='Mining PageRank is AGAINST GOOGLE'#39'S TERMS OF SERVICE. Yes, I'#39'm talking to you, scammer.';
var
  i,urllen,seedlen,key: DWORD;
begin
  key:=16909125;
  seedlen:= Length(seed)+1;
  urllen:= Length(aUrl);
  for i:=1 to urllen do
  begin
  key:= key xor (Ord(seed[i mod seedlen]) xor Ord(aUrl[i]));
  key:= key shr 23 or key shl 9;
  end;
  result:='http://www.google.com/search?client=navclient-auto&ch=8'+IntToHex(key,8)+'&features=Rank&q=info:'+aUrl;
  str_res:=Proverka.IdHTTP2.get(result);
  if Length(str_res)=11 then
  pr_res:=Copy(str_res,10,1)
  else
  pr_res:=Copy(str_res,10,2);
  if pr_res='' then pr_res:='-';
  end;

procedure TProverka.sBitBtn1Click(Sender: TObject); //Кнопка Начать. Проверка тИЦ и ЯР
var
  s: string;
  url,url_tic,url_them: string;
  i,i2,i3,str: integer;
   begin
  for str:=0 to sMemo1.Lines.Count-1 do begin
url:=sMemo1.Lines.Strings[str];
s := 'http://bar-navig.yandex.ru/u?url='+url+'&show=1';
  s := idhttp1.get(s);
  i := PosEx('value',s);
  i := PosEx('"',s,i)+1;
  i2 := PosEx('rang',s);
  i2 := PosEx('"',s,i2)+1;
  i3 := PosEx('Тема',s);
i3 := PosEx(':',s,i3)+2;
url_tic := Copy(s,i,PosEx('"',s,i)-i);
  url_yr:= Copy(s,i2,PosEx('"',s,i2)-i2);
  url_them:= Copy(s,i3,PosEx('url=',s,i3)-i3-2);
  StringGrid1.RowCount:=str+2;
  StringGrid1.Cells[0,str+1]:=url;
  StringGrid1.Cells[1,str+1]:=url_them;
  StringGrid1.Cells[2,str+1]:=url_tic;
  Check_PR(url);
  StringGrid1.Cells[3,str+1]:=pr_res;
  StringGrid1.Cells[4,str+1]:=url_yr;
end;
end;

Шаг 5. Функция Экспорт из StringGrid в Excel на Delphi

Код:

function RefToCell(ARow, ACol: Integer): string;
  begin
  Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
  end;

  function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
  const
  xlWBATWorksheet = -4167;
  var
  {Row, Col: Integer;
  GridPrevFile: string; }
  XLApp, Sheet, Data: OLEVariant;
  i, j: Integer;
  begin
  // Prepare Data
  Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
  for i := 0 to AGrid.ColCount - 1 do
  for j := 0 to AGrid.RowCount - 1 do
  Data[j + 1, i + 1] := AGrid.Cells[i, j];
  // Create Excel-OLE Object
  Result := False;
  XLApp := CreateOleObject('Excel.Application');
  try
  // Hide Excel
  XLApp.Visible := False;
  // Add new Workbook
  XLApp.Workbooks.Add(xlWBatWorkSheet);
  Sheet := XLApp.Workbooks[1].WorkSheets[1];
  Sheet.Name := ASheetName;
  // Fill up the sheet
  Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
  AGrid.ColCount)].Value := Data;
  // Save Excel Worksheet
  try
  XLApp.Workbooks[1].SaveAs(AFileName);
  Result := True;
  except
  // Error ?
  end;
  finally
  // Quit Excel
  if not VarIsEmpty(XLApp) then
  begin
  XLApp.DisplayAlerts := False;
  XLApp.Quit;
  XLAPP := Unassigned;
  Sheet := Unassigned;
  end;
  end;
  end;

procedure TProverka.Excel1Click(Sender: TObject); // кнопка Экспорт
begin
SaveDialog1.Execute;
  SaveAsExcelFile(stringGrid1, 'Проверка'+DateTostr(Date), SaveDialog1.FileName);
end;

Шаг 6. Оставшиеся функции.

Код:

procedure TProverka.FormCreate(Sender: TObject); //Заголовки таблицы
begin
  StringGrid1.Cells[0,0]:='Ресурс';
  StringGrid1.Cells[1,0]:='Тема';
  StringGrid1.Cells[2,0]:='тИЦ';
  StringGrid1.Cells[3,0]:='Pr';
  StringGrid1.Cells[4,0]:='ЯР';
end;

procedure TProverka.N1Click(Sender: TObject); //скопировать всё в буфер обмена
var
  S: string;
  GRect: TGridRect;
  C, R: Integer;
begin
  GRect := StringGrid1.Selection;
  S := '';
  for R := GRect.Top to GRect.Bottom do
  begin
  for C := GRect.Left to GRect.Right do
  begin
  if C = GRect.Right then S := S + (StringGrid1.Cells[C, R])
  else
  S := S + StringGrid1.Cells[C, R] + #9;
  end;
  S := S + #13#10;
  end;
  ClipBoard.AsText := S;
end;

procedure TProverka.sBitBtn2Click(Sender: TObject); // кнопка очистить
var i, j: Integer; begin
begin
sMemo1.Clear;
with StringGrid1 do
  for i:=FixedCols to ColCount-1 do
  for j:=FixedRows to RowCount-1 do
  Cells[i, j]:='';
  StringGrid1.RowCount:=2;
end;
end;

Готово! Осталось проверить работоспособность программы и самого модуля. Рис. 5 и Рис. 6

Иcходник программы