Skip to content

Commit

Permalink
Added ASN1String_To_UTF8 conversion.
Browse files Browse the repository at this point in the history
  • Loading branch information
@mirus77
mirus77 committed Jan 31, 2017
1 parent 7441a7d commit db0d80d
Show file tree
Hide file tree
Showing 6 changed files with 237 additions and 121 deletions.
3 changes: 3 additions & 0 deletions demo/TestEET.dpr
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program TestEET;

{$APPTYPE CONSOLE} // for debuging libxml
Expand Down
33 changes: 17 additions & 16 deletions demo/u_main.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,9 +169,10 @@ procedure TTestEETForm.DoOdeslatTrzba;
I: Integer;
ms : TMemoryStream;

function DoubleToCastka(Value : Double) : String;
function DoubleToCastkaType(Value : Double) : CastkaType;
begin
Result := FormatFloat('0.00', Value, LocFS);
Result := CastkaType.Create;
Result.DecimalString := FormatFloat('0.00', Value, LocFS);
end;

begin
Expand Down Expand Up @@ -210,20 +211,20 @@ procedure TTestEETForm.DoOdeslatTrzba;
eTrzba.Data.id_pokl := '/5546/RO24';
eTrzba.Data.porad_cis := '0/6460/ZQ42';
eTrzba.Data.dat_trzby.AsDateTime := now;
eTrzba.Data.celk_trzba.DecimalString := DoubleToCastka(34113);
eTrzba.Data.cerp_zuct.DecimalString := DoubleToCastka(679.00);
eTrzba.Data.cest_sluz.DecimalString := DoubleToCastka(5460.00);
eTrzba.Data.dan1.DecimalString := DoubleToCastka(-172.39);
eTrzba.Data.dan2.DecimalString := DoubleToCastka(-530.73);
eTrzba.Data.dan3.DecimalString := DoubleToCastka(975.65);
eTrzba.Data.pouzit_zboz1.DecimalString := DoubleToCastka(784.00);
eTrzba.Data.pouzit_zboz2.DecimalString := DoubleToCastka(967.00);
eTrzba.Data.pouzit_zboz3.DecimalString := DoubleToCastka(189.00);
eTrzba.Data.urceno_cerp_zuct.DecimalString := DoubleToCastka(324.00);
eTrzba.Data.zakl_dan1.DecimalString := DoubleToCastka(-820.92);
eTrzba.Data.zakl_dan2.DecimalString := DoubleToCastka(-3538.20);
eTrzba.Data.zakl_dan3.DecimalString := DoubleToCastka(9756.46);
eTrzba.Data.zakl_nepodl_dph.DecimalString := DoubleToCastka(3036.00);
eTrzba.Data.celk_trzba := DoubleToCastkaType(34113);
eTrzba.Data.cerp_zuct := DoubleToCastkaType(679.00);
eTrzba.Data.cest_sluz := DoubleToCastkaType(5460.00);
eTrzba.Data.dan1 := DoubleToCastkaType(-172.39);
eTrzba.Data.dan2 := DoubleToCastkaType(-530.73);
eTrzba.Data.dan3 := DoubleToCastkaType(975.65);
eTrzba.Data.pouzit_zboz1 := DoubleToCastkaType(784.00);
eTrzba.Data.pouzit_zboz2 := DoubleToCastkaType(967.00);
eTrzba.Data.pouzit_zboz3 := DoubleToCastkaType(189.00);
eTrzba.Data.urceno_cerp_zuct := DoubleToCastkaType(324.00);
eTrzba.Data.zakl_dan1 := DoubleToCastkaType(-820.92);
eTrzba.Data.zakl_dan2 := DoubleToCastkaType(-3538.20);
eTrzba.Data.zakl_dan3 := DoubleToCastkaType(9756.46);
eTrzba.Data.zakl_nepodl_dph := DoubleToCastkaType(3036.00);

// EET.SignTrzba(eTrzba); // normalizace datumu a vygenervani PKP,BKP

Expand Down
7 changes: 5 additions & 2 deletions include/eet/u_EETSigner.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ implementation
vcruntime ,
{$ENDIF}
{$ENDIF}
u_EETSignerExceptions ;
u_EETSignerExceptions;

{$IFNDEF USE_LIBEET}
const
Expand Down Expand Up @@ -432,6 +432,7 @@ procedure TEETSigner.ReadPrivKeyInfo;
a_time : TDateTime;
a_serialnumber : string;
a_subject : string;
a_issuername : string;
{$ELSE}
x509cert : libeetX509Ptr;
a_time, b_time : TDateTime;
Expand All @@ -458,7 +459,7 @@ procedure TEETSigner.ReadPrivKeyInfo;
if (xmlSecKeyDataIsValid(DataItem) and xmlSecKeyDataCheckId(DataItem, xmlSecOpenSSLKeyDataX509Id)) then
begin
x509cert := xmlSecOpenSSLKeyDataX509GetKeyCert(DataItem);
if xmlSecOpenSSLX509CertGetSubject(X509_get_subject_name(x509cert), a_subject) = 0 then
if xmlSecOpenSSLX509CertGetX509Name(X509_get_subject_name(x509cert), a_subject) = 0 then
FPrivKeyInfo.Subject := ExtractSubjectItem(a_subject, 'CN');
if Length(FPrivKeyInfo.Subject) > 2 then
if Copy(FPrivKeyInfo.Subject,1,2) = 'CZ' then
Expand All @@ -469,6 +470,8 @@ procedure TEETSigner.ReadPrivKeyInfo;
FPrivKeyInfo.notValidAfter := a_time;
if xmlSecOpenSSLX509CertGetSerialNumber(X509_get_serialNumber(x509cert), a_serialnumber) = 0 then
FPrivKeyInfo.SerialNumber :=a_serialnumber;
if xmlSecOpenSSLX509CertGetX509Name(X509_get_issuer_name(x509cert), a_issuername) = 0 then
FPrivKeyInfo.IssuerName := a_issuername;
Break;
end;
end;
Expand Down
211 changes: 112 additions & 99 deletions include/eet/u_EETTrzba.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,7 @@ TEETTrzba = class(TComponent)
function GetEETRIO : TEETRIO;
procedure SignMessage(SOAPRequest: TStream);
procedure ValidateResponse(SOAPResponse: TStream);
function EETDateTimeToXMLTime(Value: TDateTime): string;
{$IFNDEF USE_LIBEET}
procedure InsertWsse(ParentNode : IXMLNode);
{$ENDIF}
Expand All @@ -88,6 +89,7 @@ TEETTrzba = class(TComponent)
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Initialize;
procedure Finalize;
function NewTrzba : Trzba;
function SignTrzba(const parameters: Trzba): Boolean;
function OdeslaniTrzby(const parameters: Trzba; SendOnly : Boolean = false; aTimeOut : Integer = 0): Odpoved;
Expand Down Expand Up @@ -130,18 +132,13 @@ TEETTrzba = class(TComponent)

TEETTrzbaThread = class(TThread)
private
FEET: EET;
FErrorCode: Integer;
FErrorMessage: String;
FOdpoved: Odpoved;
FTrzba: Trzba;
public
ErrMessage : String;
ErrCode: Integer;
EET: EET;
EETOdpoved : Odpoved;
EETTrzba: Trzba;
procedure Execute; override;
property EET : EET read FEET write FEET;
property ETrzba : Trzba read FTrzba write FTrzba;
property EETOdpoved : Odpoved read FOdpoved;
property ErrorCode : Integer read FErrorCode;
property ErrorMessage : String read FErrorMessage;
end;

implementation
Expand Down Expand Up @@ -232,6 +229,75 @@ destructor TEETTrzba.Destroy;
inherited;
end;

function TEETTrzba.EETDateTimeToXMLTime(Value: TDateTime): string;

const
Neg: array[Boolean] of string= ('+', '-');
var
Bias: Integer;

// http://qc.embarcadero.com/wc/qcmain.aspx?d=43488
// matches the relative standard or daylight date to a real date in a given year
function EncodeDayLightChange (Change : TSystemTime; const Year : Word) : TDateTime;
begin
// wDay indicates the nth occurance of the day specified in wDayOfWeek in the given month
// wDayOfWeek indicates the day (0=sunday, 1=monday, ...,6=saturday)
// delphi coding is (7=sunday, 1=monday, ...,6=saturday)
with change do begin
if wDayOfWeek = 0 then wDayOfWeek := 7;
// Encoding the day of change (if wDay = 5 then try it and if needed decrement to find the last
// occurance of the day in this month)
while not TryEncodeDayOfWeekInMonth (Year, wMonth, wDay, wDayOfWeek, result) do begin
dec (wday); // we assume there are only 4 occurances of the given day
if wDay < 1 then // this is just to make sure it realy terminates
TryEncodeDayOfWeekInMonth (Year, wMonth, 1, 7, result)
end;
// finally add the time when change is due
result := result + EncodeTime (wHour, wMinute, 0, 0);
end;
end;

function GetTimeZoneBias(const Date: TDateTime): Integer;
var
TimeZoneInfo : TTimeZoneInformation;
DayLightBegin : tDateTime;
DayLightEnd : tDateTime;
Y,M,D : Word;

begin
case GetTimeZoneInformation(TimeZoneInfo) of
TIME_ZONE_ID_UNKNOWN: Result := TimeZoneInfo.Bias;
TIME_ZONE_ID_STANDARD,
TIME_ZONE_ID_DAYLIGHT: begin
Result := TimeZoneInfo.Bias;
// is the time we want to convert in the daylight intervall ?
DecodeDate(Date,Y,M,D);
DayLightEnd := EncodeDayLightChange (TimeZoneInfo.StandardDate, Y);
DayLightBegin := EncodeDayLightChange (TimeZoneInfo.DaylightDate, Y);
if (Date >= DayLightBegin) and (Date < DayLightEnd) then
Result := Result + TimeZoneInfo.DaylightBias;
end;
else
Result := 0;
end;
end;

begin
Result := FormatDateTime('yyyy''-''mm''-''dd''T''hh'':''nn'':''ss''', Value); { Do not localize }
Bias := GetTimeZoneBias(Value);
Result := Format('%s%s%.2d:%.2d', [Result, Neg[Bias > 0], { Do not localize }
Abs(Bias) div MinsPerHour,
Abs(Bias) mod MinsPerHour]);
end;


procedure TEETTrzba.Finalize;
begin
if FSigner.Active then FSigner.Active := False;
FCERTrustedList.Clear;
IsInitialized := False;
end;

{$IF Defined(USE_INDY) OR Defined(USE_DIRECTINDY)}
function TEETTrzba.DoVerifyPeer(Certificate: TIdX509; AOk: Boolean; ADepth, AError: Integer): Boolean;
var
Expand Down Expand Up @@ -433,20 +499,20 @@ function TEETTrzba.NewTrzba: Trzba;
Result.Data := TrzbaDataType.Create;
Result.Data.dat_trzby := dateTime.Create;
Result.Data.dat_trzby.UseZeroMilliseconds := false;
Result.Data.celk_trzba := CastkaType.Create;
Result.Data.cerp_zuct := CastkaType.Create;
Result.Data.cest_sluz := CastkaType.Create;
Result.Data.dan1 := CastkaType.Create;
Result.Data.dan2 := CastkaType.Create;
Result.Data.dan3 := CastkaType.Create;
Result.Data.pouzit_zboz1 := CastkaType.Create;
Result.Data.pouzit_zboz2 := CastkaType.Create;
Result.Data.pouzit_zboz3 := CastkaType.Create;
Result.Data.urceno_cerp_zuct := CastkaType.Create;
Result.Data.zakl_dan1 := CastkaType.Create;
Result.Data.zakl_dan2 := CastkaType.Create;
Result.Data.zakl_dan3 := CastkaType.Create;
Result.Data.zakl_nepodl_dph := CastkaType.Create;
// Result.Data.celk_trzba := CastkaType.Create;
// Result.Data.cerp_zuct := CastkaType.Create;
// Result.Data.cest_sluz := CastkaType.Create;
// Result.Data.dan1 := CastkaType.Create;
// Result.Data.dan2 := CastkaType.Create;
// Result.Data.dan3 := CastkaType.Create;
// Result.Data.pouzit_zboz1 := CastkaType.Create;
// Result.Data.pouzit_zboz2 := CastkaType.Create;
// Result.Data.pouzit_zboz3 := CastkaType.Create;
// Result.Data.urceno_cerp_zuct := CastkaType.Create;
// Result.Data.zakl_dan1 := CastkaType.Create;
// Result.Data.zakl_dan2 := CastkaType.Create;
// Result.Data.zakl_dan3 := CastkaType.Create;
// Result.Data.zakl_nepodl_dph := CastkaType.Create;

// KontrolniKody prepare
Result.KontrolniKody := TrzbaKontrolniKodyType.Create;
Expand All @@ -468,15 +534,21 @@ function TEETTrzba.OdeslaniTrzby(const parameters: Trzba; SendOnly : Boolean; aT
Result := nil;

Service := GetEET(False, URL, GetEETRIO);
if not SendOnly then SignTrzba(parameters);

// milisecond in output correction
parameters.Hlavicka.dat_odesl.XSToNative(EETDateTimeToXMLTime(parameters.Hlavicka.dat_odesl.AsDateTime));
parameters.Data.dat_trzby.XSToNative(EETDateTimeToXMLTime(parameters.Data.dat_trzby.AsDateTime));

if not SendOnly then
SignTrzba(parameters);

try
if aTimeOut <> 0 then
begin
TT := TEETTrzbaThread.Create(True);
TT.FreeOnTerminate := True;
TT.EET := Service;
TT.ETrzba := parameters;
TT.EETTrzba := parameters;
h := TT.Handle;
{$IFDEF LEGACY_RIO}
TT.Resume;
Expand All @@ -491,9 +563,9 @@ function TEETTrzba.OdeslaniTrzby(const parameters: Trzba; SendOnly : Boolean; aT
WAIT_OBJECT_0:
begin
// Thread dobìhl vèas, výsledky jsou validní, zpracovat je
FErrorCode := TT.ErrCode;
FErrorMessage := TT.ErrMessage;
Result := TT.EETOdpoved;
FErrorCode := TT.ErrorCode;
FErrorMessage := TT.ErrorMessage;
end;
else
begin
Expand All @@ -517,11 +589,11 @@ function TEETTrzba.OdeslaniTrzby(const parameters: Trzba; SendOnly : Boolean; aT
else
Result := Service.OdeslaniTrzby(parameters); { invoke the service }
except
on E:Exception do
begin
FErrorCode := -1;
FErrorMessage := E.Message;
end;
on E:Exception do
begin
FErrorCode := -3;
FErrorMessage := E.Message;
end;
end;
end;

Expand Down Expand Up @@ -750,73 +822,13 @@ procedure TEETTrzba.SignMessage(SOAPRequest: TStream);
function TEETTrzba.SignTrzba(const parameters: Trzba): Boolean;
var
sPKPData : string;

// http://qc.embarcadero.com/wc/qcmain.aspx?d=43488
// matches the relative standard or daylight date to a real date in a given year
function EncodeDayLightChange (Change : TSystemTime; const Year : Word) : TDateTime;
begin
// wDay indicates the nth occurance of the day specified in wDayOfWeek in the given month
// wDayOfWeek indicates the day (0=sunday, 1=monday, ...,6=saturday)
// delphi coding is (7=sunday, 1=monday, ...,6=saturday)
with change do begin
if wDayOfWeek = 0 then wDayOfWeek := 7;
// Encoding the day of change (if wDay = 5 then try it and if needed decrement to find the last
// occurance of the day in this month)
while not TryEncodeDayOfWeekInMonth (Year, wMonth, wDay, wDayOfWeek, result) do begin
dec (wday); // we assume there are only 4 occurances of the given day
if wDay < 1 then // this is just to make sure it realy terminates
TryEncodeDayOfWeekInMonth (Year, wMonth, 1, 7, result)
end;
// finally add the time when change is due
result := result + EncodeTime (wHour, wMinute, 0, 0);
end;
end;

function GetTimeZoneBias(const Date: TDateTime): Integer;
var
TimeZoneInfo : TTimeZoneInformation;
DayLightBegin : tDateTime;
DayLightEnd : tDateTime;
Y,M,D : Word;

begin
case GetTimeZoneInformation(TimeZoneInfo) of
TIME_ZONE_ID_UNKNOWN: Result := TimeZoneInfo.Bias;
TIME_ZONE_ID_STANDARD,
TIME_ZONE_ID_DAYLIGHT: begin
Result := TimeZoneInfo.Bias;
// is the time we want to convert in the daylight intervall ?
DecodeDate(Date,Y,M,D);
DayLightEnd := EncodeDayLightChange (TimeZoneInfo.StandardDate, Y);
DayLightBegin := EncodeDayLightChange (TimeZoneInfo.DaylightDate, Y);
if (Date >= DayLightBegin) and (Date < DayLightEnd) then
Result := Result + TimeZoneInfo.DaylightBias;
end;
else
Result := 0;
end;
end;

function DateTimeToXMLTime(Value: TDateTime): string;
const
Neg: array[Boolean] of string= ('+', '-');
var
Bias: Integer;
begin
Result := FormatDateTime('yyyy''-''mm''-''dd''T''hh'':''nn'':''ss''', Value); { Do not localize }
Bias := GetTimeZoneBias(Value);
Result := Format('%s%s%.2d:%.2d', [Result, Neg[Bias > 0], { Do not localize }
Abs(Bias) div MinsPerHour,
Abs(Bias) mod MinsPerHour]);
end;

begin
Result := False;
if not IsInitialized then exit;

// milisecond in output correction
parameters.Hlavicka.dat_odesl.XSToNative(DateTimeToXMLTime(parameters.Hlavicka.dat_odesl.AsDateTime));
parameters.Data.dat_trzby.XSToNative(DateTimeToXMLTime(parameters.Data.dat_trzby.AsDateTime));
parameters.Hlavicka.dat_odesl.XSToNative(EETDateTimeToXMLTime(parameters.Hlavicka.dat_odesl.AsDateTime));
parameters.Data.dat_trzby.XSToNative(EETDateTimeToXMLTime(parameters.Data.dat_trzby.AsDateTime));

// KontrolniKody prepare
if parameters.KontrolniKody = nil then parameters.KontrolniKody := TrzbaKontrolniKodyType.Create;
Expand Down Expand Up @@ -978,15 +990,16 @@ procedure TEETRIO.HTTPWebNode_BeforePost(const AHTTPReqResp: THTTPReqResp; AData
procedure TEETTrzbaThread.Execute;
begin
try
FOdpoved := nil;
ErrCode := 0;
EETOdpoved := nil;
CoInitialize(nil);
try
FOdpoved := EET.OdeslaniTrzby(FTrzba);
EETOdpoved := EET.OdeslaniTrzby(EETTrzba);
except
on E : Exception do
begin
FErrorCode := 2;
fErrorMessage := E.Message;
ErrCode := -3;
ErrMessage := E.Message;
end;
end;
CoUninitialize;
Expand Down
Loading

0 comments on commit db0d80d

Please sign in to comment.