Daha önce buradaki konu üzerinden faydalandığım E-Fatura görüntüleme işlemini FMX tarafına uyarladım. Fakat bazı faturalarda QR kod olan JS kodlarından kaynaklı sanırım bu alanı ekranda göstermiyor.
Delphi Sürümü : Delphi 11.0 Version 28.0.42600.6491
İşletim Sistemi :Win11
Kod: Tümünü seç
WebBrowser1.WindowsEngine := TWindowsEngine.IEOnly;Kod: Tümünü seç
type
TForm1 = class(TForm)
Button1: TButton;
WebBrowser1: TWebBrowser;
procedure Button1Click(Sender: TObject);
private
function CleanUTF8BOM(const S: string): string;
function RemoveXMLDeclaration(const S: string): string;
function ExtractEmbeddedXSLT(const XMLPath: string): string;
function TransformXMLWithEmbeddedXSLT(const XMLPath: string): string;
procedure ShowHTMLInWebBrowser(AWebBrowser: TWebBrowser; const HTMLContent: string);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Winapi.msxml,
System.NetEncoding,
System.IOUtils,
Winapi.ActiveX,
Winapi.Windows;
{$R *.fmx}
function TForm1.CleanUTF8BOM(const S: string): string;
begin
if Copy(S, 1, 3) = #$EF#$BB#$BF then
Result := Copy(S, 4, Length(S) - 3)
else
Result := S;
end;
// <?xml version="1.0" ... ?> satırını kaldırmak için
function TForm1.RemoveXMLDeclaration(const S: string): string;
var
iStart, iEnd: Integer;
begin
Result := S;
iStart := Pos('<?xml', S);
if iStart > 0 then
begin
iEnd := Pos('?>', S);
if iEnd > 0 then
Result := Trim(Copy(S, iEnd + 2, MaxInt));
end;
end;
function TForm1.ExtractEmbeddedXSLT(const XMLPath: string): string;
var
XMLDoc: IXMLDOMDocument;
Node: IXMLDOMNode;
Base64XSLT, Decoded,Decoded2: string;
begin
XMLDoc := CoDOMDocument.Create;
XMLDoc.async := False;
if not XMLDoc.load(XMLPath) then
raise Exception.Create('XML yüklenemedi: ' + XMLDoc.parseError.reason);
(XMLDoc as IXMLDOMDocument2).setProperty('SelectionLanguage', 'XPath');
Node := XMLDoc.selectSingleNode('//*[local-name()="EmbeddedDocumentBinaryObject"]');
if Node = nil then
raise Exception.Create('XSLT içeren düğüm bulunamadı.');
Base64XSLT := Trim(Node.Text);
Decoded := TEncoding.UTF8.GetString(TNetEncoding.Base64.DecodeStringToBytes(Base64XSLT));
// BOM ve XML tanımı temizleniyor
Decoded := CleanUTF8BOM(Decoded);
Decoded2 := RemoveXMLDeclaration(Decoded);
Result := Trim(Decoded2);
end;
function TForm1.TransformXMLWithEmbeddedXSLT(const XMLPath: string): string;
var
XMLDoc, XSLDoc: IXMLDOMDocument;
XSLTContent: string;
begin
CoInitialize(nil);
try
XSLTContent := ExtractEmbeddedXSLT(XMLPath);
XSLDoc := CoDOMDocument.Create;
XSLDoc.async := False;
if not XSLDoc.loadXML(XSLTContent) then
raise Exception.Create('XSLT çözümlenemedi: ' + XSLDoc.parseError.reason);
XMLDoc := CoDOMDocument.Create;
XMLDoc.async := False;
if not XMLDoc.load(XMLPath) then
raise Exception.Create('XML tekrar yüklenemedi: ' + XMLDoc.parseError.reason);
Result := XMLDoc.transformNode(XSLDoc);
finally
CoUninitialize;
end;
end;
procedure TForm1.ShowHTMLInWebBrowser(AWebBrowser: TWebBrowser; const HTMLContent: string);
var
FilePath: string;
Bytes: TBytes;
FS: TFileStream;
begin
FilePath := IncludeTrailingPathDelimiter(TPath.GetTempPath) + 'EFaturaTemp.html';
Bytes := TEncoding.UTF8.GetBytes(HTMLContent);
FS := TFileStream.Create(FilePath, fmCreate);
try
FS.WriteBuffer(Bytes, Length(Bytes));
finally
FS.Free;
end;
AWebBrowser.Navigate('file://' + FilePath);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
HTML: string;
o :TOpenDialog;
begin
try
o :=TOpenDialog.Create(Nil);
try
if O.Execute then
Begin
HTML := TransformXMLWithEmbeddedXSLT(O.FileName);
ShowHTMLInWebBrowser(WebBrowser1, HTML);
End;
finally
o.Free;
end;
except On E: Exception do
ShowMessage('HATA: ' + E.Message);
end;
end;