function vk_login(Login, Pass : string; IdHTTP : TIdHTTP): Boolean;
var
  sl : TStringList;
  text : string;
begin
  sl := TStringList.Create;
  sl.Add('email=' + Login + '&pass=' + Pass + '&expire=&vk=');
  text := IdHTTP.Post('http://login.vk.com/?act=login',sl);
  if Pos('Aoia',text)<>0 then begin
    MessageBox(Application.Handle,'Iaaa?iua aaiiua: Eiaei , Ia?ieu','Ioeaea',0);
    Result := False;
  end else begin
    text := Copy(text,Pos('name=' + #39 + 's' + #39,text)+16,PosEx(#39,text,Pos('name=' + #39 + 's' + #39,text)+17)-Pos('name=' + #39 + 's' + #39,text)-16);
    IdHTTP.Request.CustomHeaders.Add('Cookie:remixchk=5; remixsid=' + text);
    Result := True;
  end;
  sl.Free;
end;

vk_login(Edit1.Text,Edit2.Text,IdHTTP1);

function VK_ParsEmail(s:string; IdHTTP1:TIdHTTP): TStringList;
var
  i : Integer;
  mess_full, mess_text,
  mess_id, mess_new,
  mess_aut, mess_aut_id,
  mess_date, mess_title : string;
  sl : TStringList;
begin
  Result := TStringList.Create;
  i := 1;
  s := Copy(s,PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))+6,PosEx('</table>',s,Pos('<div id="messages_wrap">',s))-PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))-6);
  while PosEx('<tr ',s,i)<>0 do
  begin
    mess_full := Copy(s,PosEx('<tr ',s,i),PosEx('</tr>',s,PosEx('<tr ',s,i))-PosEx('<tr ',s,i));

    // Iieo?aiea id niiauaiey
    mess_id := Copy(mess_full,Pos('id="',mess_full)+8,PosEx('"',mess_full,Pos('id="',mess_full)+9)-Pos('id="',mess_full)-8);

    // iiaia ee yoi niiauaiea
    if Pos('class='+#39+'newRow'+#39,mess_full)<>0 then mess_new := '1' else mess_new := '0';

    if mess_new = '1' then
    begin
      // Io eiai niiauaiea
      mess_aut := Copy(mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+2,PosEx('</a>',mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+3)-PosEx('">',mess_full,Pos('<div>',mess_full)+19)-2);

      // EA iieuciaaoaey, eioi?ue i?eneae niiauaiea
      mess_aut_id := Copy(mess_full,Pos('href="',mess_full)+7,PosEx('">',mess_full,Pos('href="',mess_full)+8)-Pos('href="',mess_full)-7);

      // Aaoa, eiaaa i?eoei niiauaiea
      mess_date := Copy(mess_full,Pos('class="date">',mess_full)+13,PosEx('</div',mess_full,Pos('class="date">',mess_full)+14)-Pos('class="date">',mess_full)-13);

      //Oaia niiauaiey
      mess_title := Copy(mess_full,PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))+6,PosEx('</span>',mess_full,Pos('new messageSubject',mess_full))-PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))-6);

      // Oaeno niiauaiey
      mess_text := IdHTTP1.Get('http://vkontakte.ru/mail.php?act=show&id='+ mess_id);
      mess_text := Copy(mess_text,PosEx(';">',mess_text,Pos('class="messageText"',mess_text))+3,PosEx('</div>',mess_text,Pos('class="messageText"',mess_text))-PosEx(';">',mess_text,Pos('class="messageText"',mess_text))-3);
    end;

    Result.Add(mess_aut+' '+mess_aut_id+' '+mess_date+' '+mess_text);
    i := PosEx('<tr ',s,i)+2;
    Sleep(300);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines := VK_ParsEmail(IdHTTP1.Get('http://vkontakte.ru/mail.php'),IdHTTP1);
end;

Следите за темой на форуме. Форумчанин Dionix настроен серьезно.

Stilet:

Примерно так:
Код:

program Project1;

{$APPTYPE CONSOLE}

uses windows, SysUtils;
var hk:HKEY;
begin
   if RegOpenKey(HKEY_CURRENT_USER,’\Identities’,hk)=ERROR_SUCCESS then
     RegSaveKey(hk,’c:\temp\hk.reg’,nil);
   RegCloseKey(hk);
{ TODO -oUser -cConsole Main : Insert code here }
end.

Тема на форуме

SERG1980

Вообще есть готовые компоненты в RXLib и JEDI(JvClipBoadrMonitor,JvClipBoadr Viewer) н оесли сами хотите то вот вам пример
1.ZIP

Тема на форуме

function IsNumber(s: string): Boolean;
var
   i, v: integer;
begin
   Val(s, v, i);
   IsNumber := (i=0);
end;

в VAL третий параметр для того, чтобы вернуть ошибочное начение – если он равен нулю, значит в s число, иначе – нет (в i величина смещения в стркое, где встретилась ошибка при попытке преобразовать строку в число).

Тема на форуме

Начинающий программист может столкнуться и с такой проблемой. Для этого у компонента TWebBrowser имеется свойство:

Webbrowser1.Navigate(edit1.text);

Тема на форуме

Stilet:

Могу предложить такое:

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, Grids, StdCtrls, ComCtrls;

type
   TForm1 = class(TForm)
     ListView1: TListView;
     procedure FormCreate(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure ListView1CustomDrawItem(Sender: TCustomListView;
       Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var b:TBitmap;
   Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var e,i:integer;
begin
   b:=TBitmap.Create;
   b.LoadFromFile(’D:\stasya_ru_2_big.bmp’);
   for i:=1 to 100 do begin
     with ListView1.Items.Add do begin
       Caption:=TimeToStr(now);
       for e:=1 to 100 do SubItems.Add(TimeToStr(now));
     end;
   end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   b:=nil;
end;

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
const c=3;
var ARect:TRect;
begin
   DefaultDraw:=false;
   ARect:=Item.DisplayRect(drBounds);
   BitBlt(Sender.Canvas.Handle,ARect.Left+c,ARect.Top+c,ARect.Right-ARect.Left-c,
   ARect.Bottom-ARect.Top-c,b.Canvas.Handle,ARect.Left,ARect.Top,SRCCOPY);
end;

end.

Тема на форуме

Есть текстовый файл из 1000 строк. Там надо заменить слово “S1000″ на “S1200″, “Z100. на Z0.” , то есть многострочная замена.
Через что лучше и удобнее сделать такое?

var s:tstringlist;
begin
   s:=tstringlist.create;
   s.LoadFromFile(’файл’);
   s.text:=StringReplace(s.Text,’ S1000′,’ S1200′,[rfreplaceall]);
   s.SaveToFile(’файл’);
   FreeAndNil(s);
end.

Тема на форуме

mutabor:

Я тут расспрашивал вас о разных компонентах. Хочу тоже поделиться полезной информацией. Если кому нужны будут компоненты для перетаскивания, посмотрите на эти, очень хорошая вещь.

Тема на форуме

Posted by bullvinkle under Исходники, Пост-обзор

Код:

……………………
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
BitBuf: TBitMap;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
BitBuf:= TBitMap.Create;
BitBuf.LoadFromFile(’1.bmp’);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
BitBuf.SaveToFile(’1.ico’);
end;

end.

На форму “бросьте” кнопку Button1, в папку с проектом – файл BMP (как пример – 1.bmp) для преобразования в иконку (32 х 32 pixels).

Тема на форуме.

Вложения

Parser.rar (7.5 Кб)

Тема на форуме.