Maks150988
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору Код: 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. | |