Hello,
I have an old program (windows service) that listens.
I if get an notify message that a pay has made and that the information can be fetched.
It then puts the information in a NexusDB database.
However the old program does not function anymore due to old SSL functions.
I will try to rewrite the program with the use of RTC and Streamsec2 and if possible no XMLdocument.
But I have not the knowledge to finsch it.
I hope someone can help me.
At the end is the old program with Indy.
This is so far I have got:
----------------------------------------------------
unit Work;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, rtcDataSrv, rtcSystem, rtcInfo, rtcConn, rtcHttpSrv, Vcl.StdCtrls, rtcDataCli, rtcHttpCli;
type
TForm10 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Label1: TLabel;
Ontvangen: TLabel;
Edit1: TEdit;
Button2: TButton;
Server: TRtcHttpServer;
RtcDataProvider1: TRtcDataProvider;
RtcHttpClient1: TRtcHttpClient;
RtcDataRequest1: TRtcDataRequest;
procedure Button1Click(Sender: TObject);
procedure RtcDataProvider1CheckRequest(Sender: TRtcConnection);
procedure RtcDataProvider1DataReceived(Sender: TRtcConnection);
procedure Button2Click(Sender: TObject);
procedure RtcDataRequest1BeginRequest(Sender: TRtcConnection);
procedure RtcDataRequest1DataReceived(Sender: TRtcConnection);
private
{ Private declarations }
TransactionID_str: rtcString;
SiteURL, SitePort: rtcString;
DoDebug: boolean;
public
{ Public declarations }
end;
var
Form10: TForm10;
implementation
{$R *.dfm}
procedure TForm10.Button1Click(Sender: TObject);
begin
Server.ServerPort := Edit1.Text;
Server.Listen();
Button2.Enabled := true;
Button1.Enabled := false;
DoDebug := true;
end;
procedure TForm10.Button2Click(Sender: TObject);
begin
Server.StopListen;
Button2.Enabled := false;
Button1.Enabled := true;;
end;
procedure TForm10.RtcDataProvider1CheckRequest(Sender: TRtcConnection);
begin
with Sender as TRtcDataServer do
Memo1.Lines.Add(Request.FileName);
with Sender as TRtcDataServer do
if UpperCase(Request.FileName) = '/MSP' then
Accept;
end;
procedure TForm10.RtcDataProvider1DataReceived(Sender: TRtcConnection);
begin
with Sender as TRtcDataServer do
begin
if Request.Complete then
begin
if DoDebug then
Memo1.Lines.Clear;
TransactionID_str := Request.Query['transactionid'];
if DoDebug then
Memo1.Lines.Add(TransactionID_str);
// now get the information
RtcHttpClient1.ServerAddr := SiteURL;
RtcHttpClient1.ServerPort := SitePort;
with RtcDataRequest1 do
begin
Request.Method := 'GET';
Request.FileName := '/' + TransactionID_str;
// HERE THE XML?? HOW???
//WITH REQUEST.QUERY??
//WHAT BY 'Status ua' ??
Post; // Post the request
end;
end;
end;
end;
procedure TForm10.RtcDataRequest1BeginRequest(Sender: TRtcConnection);
begin
with TRtcDataClient(Sender) do
begin // make sure our request starts with "/"
if Copy(Request.FileName, 1, 1) <> '/' then
Request.FileName := '/' + Request.FileName;
// define the "HOST" header
if Request.Host = '' then
Request.Host := ServerAddr;
if DoDebug then
Memo1.Text := 'Requesting "' + Request.FileName + '" from "' + ServerAddr + '".';
// send request header out
WriteHeader;
end;
end;
procedure TForm10.RtcDataRequest1DataReceived(Sender: TRtcConnection);
begin
with TRtcDataClient(Sender) do
begin
if Response.Started then
begin { Executed only once per request,
when we start receiving the response. }
// Clear the info we wrote here in our "OnBeginRequest"
// HERE COMES THE XML BACK?? HOW TO HANDLE THIS?
//ALSO WITH REQUEST.QUERY??
if DoDebug then
begin
Memo1.Clear;
Memo1.Lines.Add('Status code: ' + IntToStr(Response.StatusCode));
Memo1.Lines.Add('Status text:' + Response.StatusText);
Memo1.Lines.Add('ALL Headers:');
Memo1.Lines.Add(Response.HeaderText);
Memo1.Lines.Add('Content Length:');
Memo1.Lines.Add(IntToStr(Response.ContentLength));
Memo1.Lines.Add('Content body:');
Memo1.Lines.Add('START >');
end; { Could be executed more than once, depending on the content size }
// add content received now.
Memo1.Text := Memo1.Text + Read;
if Response.Done then
begin { Executed only once per request, when we have just received it all. }
Memo1.Lines.Add('< END');
end;
end; //DoDebug
end;
end;
end.
-------------------------------------------------
======================the old program===========================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer,
IdHTTPServer,
Variants, Forms, xmldom, XMLIntf, msxmldom, XMLDoc, IdAntiFreezeBase, IdAntiFreeze,
IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
IdTCPConnection, IdTCPClient, IdHTTP, IdServerIOHandler,
IniFiles, IdContext, IdHeaderList, ActiveX, DB, nxdb, nxsdServerEngine,
nxreRemoteServerEngine, nxllComponent, nxllTransport, nxptBasePooledTransport,
nxtwWinsockTransport, Xml.omnixmldom;
type
TService1 = class(TService)
IdHTTPServer1: TIdHTTPServer;
IdServerIOHandlerSSLOpenSSL1: TIdServerIOHandlerSSLOpenSSL;
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
IdAntiFreeze1: TIdAntiFreeze;
XMLDoc1: TXMLDocument;
XMLDoc2: TXMLDocument;
nxWinsockTransport1: TnxWinsockTransport;
nxRemoteServerEngine1: TnxRemoteServerEngine;
nxSession1: TnxSession;
nxDatabase1: TnxDatabase;
DS_algpar: TDataSource;
nxT_algpar: TnxTable;
DS_IDealRecords: TDataSource;
nxT_IDealRecords: TnxTable;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure IdHTTPServer1CreatePostStream(AContext: TIdContext; AHeaders: TIdHeaderList; var VPostStream: TStream);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
{ Private declarations }
protected
function DoStop: Boolean; override;
function DoPause: Boolean; override;
function DoContinue: Boolean; override;
procedure DoInterrogate; override;
procedure DoShutdown; override;
public
constructor Create(AOwner: TComponent); override;
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
Service1: TService1;
AppsPad: string;
XML_Dir: string;
LogAanUit: string;
implementation
uses
CodeSiteLogging;
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;
constructor TService1.Create(AOwner: TComponent);
var
Ini: TInifile;
DB_naam: string;
DB_Alias: string;
DB_Poort: integer;
ServerPoort: Word;
begin
inherited;
CoInitializeEx(nil, 2);
CodeSite.Clear;
DisplayName := 'AVN Service';
// setup:
AppsPad := ExtractFilePath(Application.ExeName); // BS geen JclSysInfo meer nodig...
CodeSite.Send('AppsPad = ' + AppsPad);
Ini := TInifile.Create(AppsPad + 'AVN_SERVICE_DB_Settings.ini');
try
DB_naam := Ini.ReadString('ServerInfo', 'Server', 'NEXUSDB');
DB_Poort := Ini.ReadInteger('Transport', 'Poort', 16000); // 16000 voor gewoon 17000 voor secure
DB_Alias := Ini.ReadString('Alias', 'Aliasnaam', 'AVN');
ServerPoort := Ini.ReadInteger('Com', 'ServerPoort', 22333);
XML_Dir := Ini.ReadString('FILES', 'XML_Dir', 'C:\TEMP\');
LogAanUit := Ini.ReadString('LOG', 'LogAanUit', 'AAN');
CodeSite.Send('1a');
finally
Ini.Free;
CodeSite.Send('1b');
CodeSite.Send('DB ' + DB_naam);
CodeSite.Send('Poort ' + IntToStr(DB_Poort));
CodeSite.Send('Alias ' + DB_Alias);
end;
Application.ProcessMessages;
// setup de database connectie:
// INDIEN ALS SERVICE DAN DE INI-FILE IN DE MAP WINDOWS/SYSTEM32 ZETTEN
nxWinsockTransport1.Active := false;
CodeSite.Send('1c');
nxWinsockTransport1.ServerName := DB_naam;
CodeSite.Send('1d');
nxDatabase1.AliasPath := '';
CodeSite.Send('1e');
nxDatabase1.AliasName := DB_Alias;
CodeSite.Send('1f');
nxWinsockTransport1.Port := DB_Poort;
CodeSite.Send('1g');
nxWinsockTransport1.Active := true;
CodeSite.Send('1h');
Application.ProcessMessages;
if nxWinsockTransport1.Connected then
begin
CodeSite.Send('Database geopend');
nxRemoteServerEngine1.Active := true;
nxSession1.Active := true;
nxDatabase1.Active := true;
CodeSite.Send('Bestanden geopend');
// einde setup
nxT_algpar.Open;
nxT_IDealRecords.Open;
Application.ProcessMessages;
IdServerIOHandlerSSLOpenSSL1.SSLOptions.CertFile := nxT_algpar.FieldByName('IDeal_SSL_Cert_file').AsString;
// '83.161.204.179.cer';
IdServerIOHandlerSSLOpenSSL1.SSLOptions.KeyFile := nxT_algpar.FieldByName('IDeal_SSL_Cert_key').AsString;
// '83.161.204.179.key';
IdServerIOHandlerSSLOpenSSL1.SSLOptions.Method := sslvTLSv1_2;
IdServerIOHandlerSSLOpenSSL1.SSLOptions.Mode := sslmBoth;
IdServerIOHandlerSSLOpenSSL1.SSLOptions.VerifyMode := [];
IdServerIOHandlerSSLOpenSSL1.SSLOptions.VerifyDepth := 0;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.CertFile := nxT_algpar.FieldByName('IDeal_SSL_Cert_file').AsString;
// '83.161.204.179.cer';
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.KeyFile := nxT_algpar.FieldByName('IDeal_SSL_Cert_key').AsString;
// '83.161.204.179.key';
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvTLSv1_2;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Mode := sslmBoth;
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.VerifyMode := [];
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.VerifyDepth := 0;
Application.ProcessMessages;
end
else
CodeSite.Send('fout geen connectie');
IdHTTPServer1.DefaultPort := ServerPoort;
CodeSite.Send(IntToStr(ServerPoort));
// IdHTTPServer1.Active := true; -- BS: Dat doen we pas in de ServiceStart zelf!
OnStart := ServiceStart;
end;
function TService1.DoContinue: Boolean;
begin
CodeSite.Send('Service Continue');
try
IdHTTPServer1.Active := true;
except
on E: Exception do
CodeSite.SendException(E);
end;
Result := inherited;
end;
procedure TService1.DoInterrogate;
begin
inherited;
end;
function TService1.DoPause: Boolean;
begin
CodeSite.Send('Service Pause');
try
IdHTTPServer1.Active := false;
except
on E: Exception do
CodeSite.SendException(E);
end;
Result := inherited;
end;
procedure TService1.DoShutdown;
begin
CodeSite.Send('Service Shutdown');
try
IdHTTPServer1.Active := false;
except
on E: Exception do
CodeSite.SendException(E);
end;
inherited;
end;
function TService1.DoStop: Boolean;
begin
CodeSite.Send('Service Stop');
try
IdHTTPServer1.Active := false;
except
on E: Exception do
CodeSite.SendException(E);
end;
Result := inherited;
end;
function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService1.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
HtmlResult: String;
Request: String;
IDealRecNr: integer;
Exportfilenaam: string;
iChild, iNodeEwallet, iNodeStatus, iNode_Merchant, iNodeTransaction: IXMLNode;
Resulttekst, Statustekst: string;
Strm: TStringStream;
begin
CodeSite.EnterMethod('command get');
CoInitialize(nil);
Request := Uppercase(ARequestInfo.Document);
HtmlResult := ARequestInfo.Params.Values['transactionid'];
if HtmlResult <> '' then
begin
try
CodeSite.Send('IDealRecNr = ' + HtmlResult);
CodeSite.Send('record ontvangen');
IDealRecNr := StrToInt(HtmlResult);
// nu in database Huurovereenkomst controleren - indien OK dan VerstuurHTML:
// maak XML-file:
{ if not DirectoryExists(XML_Dir) then
CreateDir(XML_Dir);
Exportfilenaam := XML_Dir + 'IDeal_' + IntToStr(IDealRecNr) + '.XML';
dit alleen voor testen anders de volgende regel: }
Exportfilenaam := 'IDeal_' + IntToStr(IDealRecNr) + '.XML';
CodeSite.Send('Exportfilename = ' + Exportfilenaam);
XMLDoc1.Active := false;
XMLDoc1.XML.Text := '';
XMLDoc1.Active := true;
XMLDoc1.Encoding := 'UTF-8';
XMLDoc1.AddChild('Pricat', '
http://www.ean.nl');
XMLDoc1.DocumentElement := XMLDoc1.CreateNode('status');
XMLDoc1.DocumentElement.Attributes['ua'] := 'Mozilla/3.0 (compatible; Indy Library)';
// merchant
iNode_Merchant := XMLDoc1.DocumentElement.AddChild('merchant');
iChild := iNode_Merchant.AddChild('account');
iChild.Text := nxT_algpar.FieldByName('IDeal_account').AsString;
iChild := iNode_Merchant.AddChild('site_id');
iChild.Text := nxT_algpar.FieldByName('IDeal_site_id').AsString;
iChild := iNode_Merchant.AddChild('site_secure_code');
iChild.Text := nxT_algpar.FieldByName('IDeal_site_secure_id').AsString;
// transaction
iNodeTransaction := XMLDoc1.DocumentElement.AddChild('transaction');
iChild := iNodeTransaction.AddChild('id');
iChild.Text := IntToStr(IDealRecNr);
// bestand maken:
XMLDoc1.SaveToFile(Exportfilenaam);
CodeSite.Send('XMLDoc1 saved to file');
// versturen:
Strm := TStringStream.Create;
try
// alleen voor debug anders regel hieronder Strm.LoadFromFile(Exportfilenaam);
XMLDoc1.SaveToStream(Strm);
IdHTTP1.Request.ContentType := 'text/xml';
XMLDoc2.LoadFromXML(IdHTTP1.Post(nxT_algpar.FieldByName('IDeal_Site_URL').AsString, Strm));
Resulttekst := XMLDoc2.DocumentElement.Attributes['result'];
iNodeEwallet := XMLDoc2.DocumentElement.ChildNodes.FindNode('ewallet');
iNodeStatus := iNodeEwallet.ChildNodes.FindNode('status');
if Assigned(iNodeStatus) then
Statustekst := iNodeStatus.Text;
CodeSite.Send('Status = ' + Statustekst);
// database bijwerken:
if nxT_IDealRecords.FindKey([IDealRecNr]) then //hier volgend in v.1.1.0 gewijzigd omdat de status niet juist werd vertaald:
begin
if Uppercase(Resulttekst) = 'OK' then
begin
nxT_IDealRecords.Edit;
nxT_IDealRecords.FieldByName('StatusOntvangen').AsBoolean := true;
nxT_IDealRecords.FieldByName('Status').AsString := Statustekst;
if Uppercase(Statustekst) = 'COMPLETED' then
nxT_IDealRecords.FieldByName('BetalingOK').AsBoolean := true;
nxT_IDealRecords.Post;
end
else
begin
nxT_IDealRecords.Edit;
nxT_IDealRecords.FieldByName('StatusOntvangen').AsBoolean := false;
nxT_IDealRecords.FieldByName('Status').AsString := Statustekst;
nxT_IDealRecords.FieldByName('Foutkode').AsString := Resulttekst;
nxT_IDealRecords.Post;
end;
end
else
CodeSite.Send('Kan IDealrecord niet vinden');
// bewaren als laatste zodat eerst de database wordt bijgewerkt
// alleen voor debug: XMLDoc2.SaveToFile(XML_Dir + 'result' + IntToStr(IDealRecNr) + '.xml');
finally
Strm.Free;
end;
except
on E: Exception do
CodeSite.SendException('fout(en) bij communicatie', E);
end;
end;
CodeSite.ExitMethod('command get');
end;
procedure TService1.IdHTTPServer1CreatePostStream(AContext: TIdContext; AHeaders: TIdHeaderList; var VPostStream: TStream);
begin
VPostStream := TMemoryStream.Create;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
CodeSite.Send('Service Start');
CoInitialize(nil);
try
IdHTTPServer1.Active := true;
Started := true;
except
on E: Exception do
CodeSite.SendException(E);
end;
end;
procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
CoUninitialize
end;
end.
===================================
Greetings
Henk van den Boogaard