Программа регестрирует короткие ссылки на сайте 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.
|