Автор: Maks150988
Дата сообщения: 08.07.2011 22:38
Frodo_Torbins
[more=Код]
Код: unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinInet;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
type
TBillingInfo = packed record
realmID : Integer;
sessionID : AnsiString;
userIP : AnsiString;
cardName : AnsiString;
subscrName : AnsiString;
balanceMoney: Double;
balanceDraft: Double;
tarifName : AnsiString;
daysLeft : Integer;
end;
implementation
{$R *.dfm}
function ExtractSubString(TextSource, TextBefore, TextAfter: AnsiString): AnsiString;
var
UcStr : AnsiString;
UcBefore : AnsiString;
UcAfter : AnsiString;
SrcLen : Integer;
BeforeLen : Integer;
AfterLen : Integer;
StartPos : Integer;
EndPos : Integer;
Searching : Boolean;
begin
Result := '';
UcStr := LowerCase(TextSource);
UcBefore := LowerCase(TextBefore);
UcAfter := Lowercase(TextAfter);
SrcLen := Length(UcStr);
BeforeLen := Length(UcBefore);
AfterLen := Length(UcAfter);
StartPos := Pos(UcBefore, UcStr);
if (StartPos = 0) then
Exit;
StartPos := StartPos + BeforeLen;
EndPos := StartPos;
Searching := EndPos <= SrcLen;
while Searching do
begin
if (Copy(UcStr, EndPos, AfterLen) = UcAfter) then
Result := Copy(TextSource, StartPos, EndPos - StartPos);
if (Result <> '') then
Searching := FALSE
else
begin
EndPos := EndPos + 1;
Searching := EndPos <= SrcLen;
end;
end;
end;
// Функция составляет строку SOAP запроса из шаблона.
function CreateSoapRequest(func: AnsiString; args, keys: Array of AnsiString): Utf8String;
var
dwItem : Integer;
pszTemp: AnsiString;
pszArg : AnsiString;
begin
Result :=
'<?xml version="1.0" encoding="UTF-8"?>' + sLineBreak +
'<soap12:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap12="http://www.w3.org/2003/05/soap-envelope">' + sLineBreak +
' <soap12:Body>' + sLineBreak +
' <%func% xmlns="AIST-CARDS-USER-SERVICE">' + sLineBreak +
' %args%' + sLineBreak +
' </%func%>' + sLineBreak +
' </soap12:Body>' + sLineBreak +
'</soap12:Envelope>';
Result := StringReplace(Result, '%func%', func, [rfReplaceAll, rfIgnoreCase]);
for dwItem := Low(args) to High(args) do
begin
pszTemp := StringReplace(' <%arg%>%key%</%arg%>', '%arg%', args[dwItem], [rfReplaceAll, rfIgnoreCase]);
pszTemp := StringReplace(pszTemp, '%key%', keys[dwItem], [rfReplaceAll, rfIgnoreCase]);
pszArg := pszArg + pszTemp + sLineBreak;
end;
pszTemp := StringReplace(Result, '%args%', Trim(pszArg), [rfReplaceAll, rfIgnoreCase]);
Result := AnsiToUtf8(pszTemp);
end;
// Функция отправляет SOAP запрос на сервер и возвращает от него ответ.
function SendSoapRequest(hResourceHandle: HINTERNET; pszSoap: Utf8String): AnsiString;
var
dwStatus : DWORD;
dwStatusSize : DWORD;
dwReserved : DWORD;
bRet : Boolean;
pszText : Utf8String;
dwBytesToWrite: DWORD;
dwBytesRead : DWORD;
begin
Result := '';
bRet := HttpSendRequest(hResourceHandle, nil, 0, LPTSTR(pszSoap), lstrlen(LPTSTR(pszSoap)));
if bRet then
begin
dwStatus := 0;
dwStatusSize := SizeOf(dwStatus);
dwReserved := 0;
bRet := HttpQueryInfo(
hResourceHandle,
HTTP_QUERY_FLAG_NUMBER or HTTP_QUERY_STATUS_CODE,
@dwStatus,
dwStatusSize,
dwReserved
);
if (bRet and (dwStatus = HTTP_STATUS_OK)) then
begin
bRet := InternetQueryDataAvailable(hResourceHandle, dwBytesToWrite, 0, 0);
if (bRet and (dwBytesToWrite > 0)) then
begin
SetLength(pszText, dwBytesToWrite);
repeat
bRet := InternetReadFile(hResourceHandle, LPTSTR(pszText), dwBytesToWrite, dwBytesRead);
if (bRet and (dwBytesRead > 0)) then
begin
SetLength(pszText, dwBytesRead);
Result := Result + Utf8ToAnsi(pszText);
end;
until
dwBytesRead = 0;
end;
end;
end;
end;
// Функция извлекает подстроку из XML файла после SOAP запроса.
function GetSoapValue(pszSoap, pszKey: AnsiString): AnsiString;
var
pszval1: AnsiString;
pszval2: AnsiString;
begin
pszval1 := StringReplace('<%key%>', '%key%', pszKey, [rfReplaceAll, rfIgnoreCase]);
pszval2 := StringReplace('</%key%>', '%key%', pszKey, [rfReplaceAll, rfIgnoreCase]);
Result := ExtractSubString(pszSoap, pszval1, pszval2);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hOpenHandle : HINTERNET;
hConnectHandle : HINTERNET;
hResourceHandle: HINTERNET;
pszSoap : Utf8String;
pszTemp : AnsiString;
pszText : AnsiString;
binfo : TBillingInfo;
{
stCurrent : TSystemTime;
dtCurrent : _TDateTime;
dtChange : _TDateTime;
}
begin
ZeroMemory(@binfo, SizeOf(TBillingInfo));
hOpenHandle := InternetOpen(
nil,
INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil,
0
);
if Assigned(hOpenHandle) then
try
hConnectHandle := InternetConnect(
hOpenHandle,
LPTSTR('cardsusr.tlt.aist.net.ru'),
9001,
nil,
nil,
INTERNET_SERVICE_HTTP,
0,
0
);
if Assigned(hConnectHandle) then
try
hResourceHandle := HttpOpenRequest(
hConnectHandle,
LPTSTR('POST'),
LPTSTR('/service.asmx'),
LPTSTR(HTTP_VERSION),
nil,
nil,
INTERNET_FLAG_SECURE or INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_RELOAD,
0
);
if Assigned(hResourceHandle) then
try
pszText := 'Host: cardsusr.tlt.aist.net.ru' + sLineBreak;
HttpAddRequestHeaders(hResourceHandle, LPTSTR(pszText), lstrlen(LPTSTR(pszText)), HTTP_ADDREQ_FLAG_ADD);
pszText := 'Content-Type: application/soap+xml; charset=utf-8' + sLineBreak;
HttpAddRequestHeaders(hResourceHandle, LPTSTR(pszText), lstrlen(LPTSTR(pszText)), HTTP_ADDREQ_FLAG_ADD);
// Извлекаем идентификатор услуги.
pszSoap := CreateSoapRequest('GetRealmIdByCard', ['CardName'], [Edit1.Text]);
pszText := Format('Content-Length: %d', [lstrlen(LPTSTR(pszSoap))]) + sLineBreak;
HttpAddRequestHeaders(hResourceHandle, LPTSTR(pszText), lstrlen(LPTSTR(pszText)), HTTP_ADDREQ_FLAG_ADD);
pszTemp := SendSoapRequest(hResourceHandle, pszSoap);
pszText := GetSoapValue(pszTemp, 'GetRealmIdByCardResult');
binfo.realmid := StrToIntDef(pszText, 0);
// Извлекаем идентификатор текущей сессии и IP адрес пользователя.
pszSoap := CreateSoapRequest('LoginByRealmID2', ['realmID', 'login', 'password', 'userIP'], [IntToStr(binfo.realmid), Edit1.Text, Edit2.Text, '81.28.160.1']);
pszText := Format('Content-Length: %d', [lstrlen(LPTSTR(pszSoap))]) + sLineBreak;
HttpAddRequestHeaders(hResourceHandle, LPTSTR(pszText), lstrlen(LPTSTR(pszText)), HTTP_ADDREQ_FLAG_REPLACE);
pszTemp := SendSoapRequest(hResourceHandle, pszSoap);
pszText := GetSoapValue(pszTemp, 'sessionID');
binfo.sessionID := pszText;
pszText := GetSoapValue(pszTemp, 'userIP');
binfo.userIP := pszText;
// Извлекаем сведения о биллинге пользователя.
pszSoap := CreateSoapRequest('GetCardInfo', ['sessionID', 'userIP'], [binfo.sessionID, binfo.userIP]);
pszText := Format('Content-Length: %d', [lstrlen(LPTSTR(pszSoap))]) + sLineBreak;
HttpAddRequestHeaders(hResourceHandle, LPTSTR(pszText), lstrlen(LPTSTR(pszText)), HTTP_ADDREQ_FLAG_REPLACE);
pszTemp := SendSoapRequest(hResourceHandle, pszSoap);
{
pszText := GetSoapValue(pszTemp, 'CARD_NAME');
binfo.cardName := pszText;
pszText := GetSoapValue(pszTemp, 'USER_NAME');
binfo.subscrName := pszText;
pszText := GetSoapValue(pszTemp, 'ACCOUNT_MONEY');
pszText := StringReplace(pszText, '.', ',', [rfReplaceAll, rfIgnoreCase]);
binfo.balanceMoney := StrToFloat(pszText);
pszText := GetSoapValue(pszTemp, 'ACCOUNT_OVERDRAFT');
pszText := StringReplace(pszText, '.', ',', [rfReplaceAll, rfIgnoreCase]);
binfo.balanceDraft := StrToFloat(pszText);
pszText := GetSoapValue(pszTemp, 'TARIF_PLAN_COMMENT');
binfo.tarifName := pszText;
ZeroMemory(@stCurrent, SizeOf(TSystemTime));
GetLocalTime(stCurrent);
if (binfo.realmID = 2) then
begin
pszText := GetSoapValue(pszTemp, 'TARIF_CHANGE_TIME');
dtCurrent := _SystemTimeToDateTime(stCurrent);
dtChange := UniversalTimeToDateTime(pszText);
binfo.daysLeft := _DaysBetween(dtChange, dtCurrent);
end;
}
// Завершаем текущую сессию.
pszSoap := CreateSoapRequest('LogoffResponse', ['sessionID', 'userIP'], [binfo.sessionID, binfo.userIP]);
pszText := Format('Content-Length: %d', [lstrlen(LPTSTR(pszSoap))]) + sLineBreak;
HttpAddRequestHeaders(hResourceHandle, LPTSTR(pszText), lstrlen(LPTSTR(pszText)), HTTP_ADDREQ_FLAG_REPLACE);
pszTemp := SendSoapRequest(hResourceHandle, pszSoap);
// Отображаем окончательные данные о биллинге.
{
Memo1.Text := Format('ID услуги : %d', [binfo.realmID]) + sLineBreak;
Memo1.Text := Memo1.Text + Format('ID сессии : %s', [binfo.sessionID]) + sLineBreak;
Memo1.Text := Memo1.Text + Format('IP адрес : %s', [binfo.userIP]) + sLineBreak + sLineBreak;
Memo1.Text := Memo1.Text + Format('Номер : %s', [binfo.cardName]) + sLineBreak;
Memo1.Text := Memo1.Text + Format('Имя абонента : %s', [binfo.subscrName]) + sLineBreak;
Memo1.Text := Memo1.Text + Format('Остаток (руб) : %f', [binfo.balanceMoney]) + sLineBreak;
Memo1.Text := Memo1.Text + Format('Овердрафт (руб): %f', [binfo.balanceDraft]) + sLineBreak;
Memo1.Text := Memo1.Text + Format('Тарифный план : %s', [binfo.tarifName]) + sLineBreak;
if (binfo.realmID = 2) then
Memo1.Text := Memo1.Text + Format('Осталось дней : %d', [binfo.daysLeft]) + sLineBreak;
pszText := Format('%d:%d:%d %d.%d.%d', [stCurrent.wHour, stCurrent.wMinute, stCurrent.wSecond, stCurrent.wDay, stCurrent.wMonth, stCurrent.wYear]);
Memo1.Text := Memo1.Text + sLineBreak + Format('Дата обновления: %s', [pszText]) + sLineBreak;
}
finally
InternetCloseHandle(hResourceHandle);
end;
finally
InternetCloseHandle(hConnectHandle);
end;
finally
InternetCloseHandle(hOpenHandle);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{
}
end;
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
end;
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
end;
end.
По очереди отпарсиваете все параметры (благо все фиксированно), если смещение по часовому поясу не нужно, то нафиг, если нужно, то прибавляем (отнимаем), а потом куда надо (TDateTime, TSystemTime) загоняем и работаем. Есть куча способов (от StrToDate до всяких конверт) чтобы потом получить дату, время и тп.