unit
Unit1;
interface
uses
Winapi
.
Windows, Winapi
.
Messages, System
.
SysUtils, System
.
Variants, System
.
Classes, Vcl
.
Graphics,
Vcl
.
Controls, Vcl
.
Forms, Vcl
.
Dialogs, Vcl
.
StdCtrls,httpsend,ssl_openssl,lib,
Vcl
.
ComCtrls, System
.
StrUtils, Xml
.
xmldom, Xml
.
XMLIntf, Xml
.
XMLDoc,
Vcl
.
Buttons, Vcl
.
Grids, FireDAC
.
Stan
.
StorageXML, ComObj, msxml, Vcl
.
ExtCtrls,
NiceGrid;
type
TForm1 =
class
(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
Button3: TButton;
Edit3: TEdit;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
ListBox1: TListBox;
BitBtn1: TBitBtn;
XMLDocument1: TXMLDocument;
StringGrid1: TNiceGrid;
procedure
Button1Click(Sender: TObject);
procedure
Button2Click(Sender: TObject);
procedure
Button3Click(Sender: TObject);
procedure
Button7Click(Sender: TObject);
procedure
Button5Click(Sender: TObject);
procedure
BitBtn1Click(Sender: TObject);
private
public
email,pass,response,msg,userid:
string
;
end
;
var
Form1: TForm1;
token:
string
;
implementation
{$R *.dfm}
procedure
TForm1
.
BitBtn1Click(Sender: TObject);
var
i, n:
integer
;
s,t:
string
;
Nodes: IXMLDomNodeList;
doc :IXMLDOMDocument;
begin
Doc := CreateComObject(CLASS_DOMDocument)
as
IXMLDOMDocument;
Doc
.
load(
'data.xml'
);
Nodes := Doc
.
selectNodes(
'//post/*'
);
n:=
0
;
for
i:=
0
to
Nodes
.
length-
1
do
begin
if
Nodes
.
nodeName=
'text'
then
begin
n:=n+
1
;
s:=(Format(
'%s'
, [Nodes
.
text]));
t:=StringReplace( s, #
10
, #
39
'+#10#13+'
#
39
, [rfReplaceAll]);
StringGrid1
.
Cells[
0
,n]:=#
39
+t+ #
39
;
StringGrid1
.
RowCount:=StringGrid1
.
RowCount+
1
;
end
;
if
Nodes
.
nodeName=
'photo_130'
then
begin
StringGrid1
.
Cells[
1
,n]:=(Format(
'%s'
, [Nodes
.
text]));
end
;
if
Nodes
.
nodeName=
'comments'
then
begin
StringGrid1
.
Cells[
2
,n]:=(Format(
'%s'
, [Nodes
.
text]));
end
;
if
Nodes
.
nodeName=
'likes'
then
begin
StringGrid1
.
Cells[
3
,n]:=(Format(
'%s'
, [Nodes
.
text]));
end
;
if
Nodes
.
nodeName=
'reposts'
then
begin
StringGrid1
.
Cells[
4
,n]:=(Format(
'%s'
, [Nodes
.
text]));
end
;
end
;
Doc :=
nil
;
end
;
procedure
TForm1
.
Button1Click(Sender: TObject);
var
s2:
string
;
begin
email:=Edit1
.
Text;
pass:=Edit2
.
Text;
msg:=response;
if
Pos(
'token'
,response) <>
0
then
begin
s2:=copy(response, pos(
'access_token":"'
, response), pos(
'","expires_in'
, response)-
3
);
delete(s2,
1
,
15
);
token:=s2;
Memo1
.
Lines
.
Add(msg);
msg:=token;
userid:=s2;
s2:=Copy(response,Pos(
'user_id":'
,response),Pos(
'}'
,response));
Delete(s2,
1
,
9
);
Delete(s2,Pos(
'}'
,s2),
1
);
userid:=s2;
Memo1
.
Lines
.
Add(msg);
msg:=userid;
Memo1
.
lines
.
add (msg);
end
else
begin
memo1
.
lines
.
add(
'Error'
);
end
;
end
;
procedure
TForm1
.
Button2Click(Sender: TObject);
begin
msg:=response;
Memo1
.
Lines
.
Add(msg)
end
;
function
UrlEncode(Str:
ansistring
):
ansistring
;
function
CharToHex(Ch:
ansiChar
):
Integer
;
asm
and
eax, 0FFh
mov ah, al
shr
al,
4
and
ah, 00fh
cmp al, 00ah
jl @@
10
sub al, 00ah
add al, 041h
jmp @@
20
@@
10
:
add al, 030h
@@
20
:
cmp ah, 00ah
jl @@
30
sub ah, 00ah
add ah, 041h
jmp @@
40
@@
30
:
add ah, 030h
@@
40
:
shl
eax,
8
mov al,
'%'
end
;
var
i, Len:
Integer
;
Ch:
ansiChar
;
N:
Integer
;
P:
PansiChar
;
begin
Result :=
''
;
Len := Length(Str);
P :=
PansiChar
(@N);
for
i :=
1
to
Len
do
begin
Ch := Str;
if
Ch
in
[
'0'
..
'9'
,
'A'
..
'Z'
,
'a'
..
'z'
,
'_'
]
then
Result := Result + Ch
else
begin
if
Ch =
' '
then
Result := Result +
'+'
else
begin
N := CharToHex(Ch);
Result := Result + P;
end
;
end
;
end
;
end
;
procedure
TForm1
.
Button3Click(Sender: TObject);
begin
response:= send (
'GET'
,
'https://api.vk.com/method/wall.post?owner_id=ИД_пользователя&message='
+UrlEncode(AnsiToUTF8(
'Салат "Лисичка"'
+#
10
#
13
+
''
+#
10
#
13
+
'Ингредиенты:'
+#
10
#
13
+
'2 филе куриной грудки'
+#
10
#
13
+
'3 маринованных огурца'
+#
10
#
13
+
'200 гр. корейской моркови'
+#
10
#
13
+
'200 гр. сыра'
+#
10
#
13
+
'2 зубчика чеснока'
+#
10
#
13
+
'майонез'
+#
10
#
13
+
'зелень'
+#
10
#
13
+
''
+#
10
#
13
+
'Приготовление:'
+#
10
#
13
+
'1. Филе отвариваем в подсоленной воде,затем нарезаем полосочками (или разбираем руками на волокна).'
+#
10
#
13
+
'2. Огурцы также нарезаем полосочками,сыр на крупной терке.'
+#
10
#
13
+
'3. Смешиваем филе.сыр,огурцы и морковь,добавляем выдавленный через пресс чеснок и заправляем майонезом.'
))+
'&access_token='
+token);
msg:=response;
if
Pos(
'post_id'
,response)<>
0
then
begin
Memo1
.
Lines
.
Clear;
Memo1
.
Lines
.
Add(
'Пост отправлен'
+msg);
end
else
begin
Memo1
.
Lines
.
Add(
'Вы не авторизованы'
+msg);
end
;
end
;
procedure
TForm1
.
Button5Click(Sender: TObject);
begin
end
;
procedure
TForm1
.
Button7Click(Sender: TObject);
begin
end
;
end
.