Einzelnen Beitrag anzeigen

cobus_tschulz

Registriert seit: 31. Jan 2010
15 Beiträge
 
#18

Re: TWebbrowser Werte in Lable.Caption darstellen

  Alt 3. Feb 2010, 11:14
Hier der ganze Code ... hab nen bisschen auskommentiert und so was ich mal probiert hatte also davon nicht stören lassen

Delphi-Quellcode:
unit uCSUSTIDtools;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ActiveX, ExtCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,StrUtils ;

type
  TTFrmMain = class(TForm)
    eUSTID1: TEdit;
    eUSTID2: TEdit;
    eFirmenname: TEdit;
    eOrt: TEdit;
    ePLZ: TEdit;
    eStrasse: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    btnAnfrageSenden: TButton;
    cmbDrucken: TComboBox;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    eRGueltigAb: TEdit;
    Label11: TLabel;
    eRGueltigBis: TEdit;
    Label12: TLabel;
    eRFirmenname: TEdit;
    Label13: TLabel;
    eROrt: TEdit;
    Label14: TLabel;
    eRPLZ: TEdit;
    Label15: TLabel;
    eRStrasse: TEdit;
    Button1: TButton;
    eRAnfrangeAm: TEdit;
    Label16: TLabel;
    Label17: TLabel;
    eRAnfrageUm: TEdit;
    Label18: TLabel;
    eRErrorCode: TEdit;
    Panel1: TPanel;
    Label19: TLabel;
    Label20: TLabel;
    IdHTTP1: TIdHTTP;
    lErrorCode: TLabel;
    Memo1: TMemo;
    procedure btnAnfrageSendenClick(Sender: TObject);
  private
  public
    { Public-Deklarationen }
  end;

var
  TFrmMain: TTFrmMain;

implementation

uses
  mshtml;

{$R *.dfm}

// CEigene
function WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
begin
  ps := WebBrowser.Document as IPersistStreamInit;
  s := '';
  ss := TStringStream.Create(s);
  try
    sa := TStreamAdapter.Create(ss, soReference) as IStream;
    Result := Succeeded(ps.Save(sa, True));
    if Result then ACode.Add(ss.Datastring);
  finally
    ss.Free;
  end;
end;


procedure TTFrmMain.btnAnfrageSendenClick(Sender: TObject);
var
  MyIdHTTP: TIdHTTP;
  HTMLCode: string;
  kompletterCode :string;
  RError,RGueltigBis,RGuelitgAb,RAnfrageAm,RAnfrageUm :string;
  s: String;
  errorcode: string;
  i: integer;

begin

// Abfrage der Felder für die Eingabe die dürfen nicht leer sein
    (*
    If (eUSTID1.text = '')  or (eUSTID2.text = '')
                              or (eFirmenname.text = '')
                              or (eOrt.text = '')
                              or (ePlz.text = '')
                              or (eStrasse.text = '')
                              or (cmbDrucken.text = '') then
          begin
            showmessage('Die Eingabe weist Fehler auf. Bitte prüfen Sie die Eingabe.');
            exit;
          end;

  *)



// Anfrage zur USTID Seite stellen und in das Memo1 Feld schreiben.
MyIdHTTP := TIdHTTP.Create;
try
  HTMLCode := MyIdHTTP.Get('http://evatr.bff-online.de/evatrRPC?UstId_1='+eUSTID1.Text+
            '&UstId_2='+eUSTID2.Text+
            '&Firmenname='+eFirmenname.Text+
            '&Ort='+eOrt.Text+
            '&PLZ='+ePlz.Text+
            '&Strasse='+eStrasse.Text+
            '&Druck='+cmbDrucken.Text);

memo1.Text := HTMLCode;
for i := Memo1.Lines.Count - 1 downto 0 do
  if AnsiPos('ErrorCode', Memo1.Lines.Strings[i]) > 0 then
  begin
    Memo1.text := Memo1.Lines.Strings[i + 1];
    Memo1.text := StringReplace(memo1.Text, '/', '', [rfReplaceAll]);
    Memo1.text := StringReplace(memo1.Text, '<value>', '', [rfReplaceAll]);
    Memo1.text := StringReplace(memo1.Text, '<string>', '', [rfReplaceAll]);
    break;
  end;

  ShowMessage(memo1.text);


           // memo1.text := {StrUtils.}AnsiReplaceText(HTMLCode,'<',sLineBreak + '<');

//for i := Memo1.Lines.Count - 1 DownTo 0 do
// if (Trim(memo1.lines[i]) = '') or (Trim(memo1.lines[i])[1] = '<') then
// memo1.lines.Delete(i);

//s := AnsiReplaceText(HTMLCode,'<',#13 + '<');
//ErrorCode := s.IndexOf('ErrorCode') + 1 ;

  //ShowMessage(memo1.text);

(*

    s := HtmlCode;
    // Hinweiss hier: 1. Zahl ist AB Zeichen und 2. Zahl ist WIEVIELE zeichen
    RError := Copy(s, 231, 3);
    RGuelitgAb := Copy(s, 1582,3);
    RGueltigBis := Copy(s, 1582,3);
    RAnfrageAm := Copy(s, 905,10);
    RAnfrageUm := Copy(s, 1316, 8);

    // Fehlercodes umwanden in Texte . Fehlercodes stehen auf [url]http://evatr.bff-online.de/eVatR/xmlrpc/codes[/url]
    RError := StringReplace(RError, '215', 'Ihre Anfrage enthält nicht alle notwendigen Angaben für eine einfache Bestätigungsanfrage (Ihre deutsche USt-IdNr. und die ausl. USt-IdNr.).Ihre Anfrage kann deshalb nicht bearbeitet werden. ', [rfReplaceAll, rfIgnoreCase]);
    RError := StringReplace(RError, '200', 'Die angefragte USt-IdNr. ist gültig. ', [rfReplaceAll, rfIgnoreCase]);

    eRErrorCode.Text := RError;
    lErrorCode.Caption := RError;
    eRGueltigAb.Text :=  RGuelitgAb;
    eRAnfrangeAm.Text := RAnfrageAm;
    eRAnfrageUm.Text := RAnfrageUm;

    // Umwandeln der Codes in Werte
    // s := HtmlCode;
    // s := StringReplace(s, '215', 'Falscher Wert', [rfReplaceAll, rfIgnoreCase]);
    // ShowMessage(s);


*)


finally
  FreeAndNil(MyIdHTTP);

end;

end;


end.
  Mit Zitat antworten Zitat