DELPHI Воскресенье, 05.05.2024, 20:31
Приветствую Вас Гость | RSS
Меню сайта

Разделы новостей
Статьи [1]
Примеры программ [4871]
Компоненты Delphi [3]
Секреты Delphi [1]
Полезное [92]
Мои разработки [3]

Начало » 2007 » Апрель » 20 » Shurl Regger
Shurl Regger
Программа регестрирует короткие ссылки на сайте http://shurl.org/

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ShellApi, GruString, StrUtils, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdAntiFreezeBase,
IdAntiFreeze, Gauges;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
GroupBox1: TGroupBox;
Edit1: TEdit;
Button1: TButton;
GroupBox2: TGroupBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Label2: TLabel;
GroupBox3: TGroupBox;
Memo1: TMemo;
GroupBox4: TGroupBox;
Label3: TLabel;
Edit2: TEdit;
CheckBox1: TCheckBox;
Label4: TLabel;
Label5: TLabel;
Memo2: TMemo;
Button6: TButton;
Button7: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
PopupMenu1: TPopupMenu;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
IdHTTP1: TIdHTTP;
Memo3: TMemo;
IdAntiFreeze1: TIdAntiFreeze;
ListBox1: TListBox;
Gauge1: TGauge;
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure N9Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.N2Click(Sender: TObject);
begin
OpenDialog1.Execute;
if OpenDialog1.FileName<>'' then
begin
ListBox1.Items.LoadFromFile(OpenDialog1.FileName);
end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
SaveDialog1.Execute;
if ListBox1.Items.Text<>'' then
begin
ListBox1.Items.SaveToFile(SaveDialog1.FileName + '.txt');
end
else
Application.MessageBox('Ôàéë íå ñîõðàíåí, òàê êàê ïîëå ñ ñóáäîìåíîì ïóñòîå','Îøèáêà',mb_OK);
end;

procedure TForm1.N4Click(Sender: TObject);
begin
Application.ProcessMessages;
DeleteCopy(ListBox1.Items);
end;

procedure TForm1.N5Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
ListBox1.Clear;
Memo1.Clear;
Memo2.Clear;
Edit1.Clear;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Application.ProcessMessages;
DelEmpStrings(ListBox1.Items);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
chto,na:string;
begin
chto := InputBox('Çàìåíà','×òî Âû õîòèòå çàìåíèòü?','');
if chto<>'' then
begin
na := InputBox('Çàìåíà','Íà ÷òî Âû õîòèòå çàìåíèòü ' + chto + '?','');
ListBox1.Items.Text := AnsireplaceStr(ListBox1.Items.Text,chto,na);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit1.Text<>'' then
begin
ListBox1.Items.Add(Edit1.Text);
Edit1.Clear;
end;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
ListBox1.DeleteSelected;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
ListBox1.DeleteSelected;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
ListBox1.Clear;
end;

procedure TForm1.N12Click(Sender: TObject);
begin
Application.MessageBox(PChar(IntToStr(ListBox1.Items.Count)),'Êîëè÷åñòâî ñóáäîìåíîâ',mb_OK);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
ListBox1.Clear;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
i,pos1,trust:integer;
Post: TStrings;
query,sub,long,responce:string;
begin
IdAntiFreeze1.Process;
Gauge1.MaxValue := ListBox1.Items.Count;
try
for i:=0 to ListBox1.Items.Count do
begin
Gauge1.Progress := i;
Memo3.Clear;
query := ListBox1.Items[i];
query := AnsireplaceStr(query,' ','+');
query := AnsireplaceStr(query,'_','+');
query := AnsireplaceStr(query,'.','+');
sub := ListBox1.Items[i];
sub := AnsireplaceStr(sub,' ','-');
sub := AnsireplaceStr(sub,'_','-');
sub := AnsireplaceStr(sub,'.','-');
long := Edit2.Text;
long := AnsireplaceStr(long,'[QUERY]',query);
Post := TStringList.Create;
Post.Clear;
Post.Add('url='+long);
Post.Add('name='+sub);
if CheckBox1.Checked=true then
begin
Post.Add('urlmasking=true');
end;
Memo3.Text := IdHTTP1.Post('http://shurl.org/advanced', Post);
responce := Memo3.Text;
pos1 := pos('occupied',responce);
if pos1=0 then
begin
Memo1.Lines.Add('http://shurl.org/' + sub);
end
else
Memo2.Lines.Add('http://shurl.org/' + sub);
end;
except
end;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
AboutBox.Show;
end;

end.

Категория: Мои разработки | Просмотров: 10720 | Добавил: ADMIN | Рейтинг: 0.0 |
Всего комментариев: 7
7 Griefeendono  
0
http://loveepicentre.com/success_stories.php - http://loveepicentre.com/uploades/photos/9.jpg
dating services forums http://loveepicentre.com/testimonials.php - adult dating link reviews interracial dating marriage is wrong
dating ariane couch http://loveepicentre.com/success_stories.php - dating anonymous data on std's and dating
scott stapp dating http://loveepicentre.com/map.php - free online caribbean dating servic radioactive dating is fun

6 ViffAccorrom  
0
online personals dating services http://loveepicentre.com/testimonials.php who is maks dating

5 oraperbbeisp  
0
ellingsons pharmacy oregon http://sundrugstore.net/products/kamagra-soft.htm pharmacy drug store

4 oraperbbeisp  
0
kenwood pharmacy fayetteville georgia http://sundrugstore.net/products/viagra.htm community professional pharmacy riverside ca

3 oraperbbeisp  
0
california board of pharmacy http://sundrugstore.net/products/leukeran.htm herbal pharmacy

2 lixeviply  
0
coltons pharmacy elizabeth nj http://sundrugstore.net/products/cefixime.htm johnson county pharmacy associations in iowa

1 Антонович  
0
Огромное спасибо!

Имя *:
Email *:
Код *:
Форма входа

Календарь новостей
«  Апрель 2007  »
ПнВтСрЧтПтСбВс
      1
2345678
9101112131415
16171819202122
23242526272829
30

Поиск по новостям

Друзья сайта

Статистика

Copyright MyCorp © 2006