衛署許可證查詢網頁範例-DELPHI6-v.2(取得有效日期)

請拉1 x Button 1 x WebBrowser,

範例如下
[code delphi]
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls, ActiveX;

type
TForm1 = class(TForm)
Button1: TButton;
WebBrowser1: TWebBrowser;
procedure Button1Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function _strcspn(s1, s2: PChar): Cardinal; cdecl;
var
SrchS2: PChar;
begin
Result := 0;
while S1^ <> #0 do
begin
SrchS2 := S2;
while SrchS2^ <> #0 do
begin
if S1^ = SrchS2^ then
Exit;
Inc(SrchS2);
end;
Inc(S1);
Inc(Result);
end;
end;

function GetWebBrowserHTML(const WebBrowser: TWebBrowser): String;
var
LStream: TStringStream;
Stream : IStream;
LPersistStreamInit : IPersistStreamInit;
begin
if not Assigned(WebBrowser.Document) then exit;
LStream := TStringStream.Create('');
try
LPersistStreamInit := WebBrowser.Document as IPersistStreamInit;
Stream := TStreamAdapter.Create(LStream,soReference);
LPersistStreamInit.Save(Stream,true);
result := LStream.DataString;
finally
LStream.Free();
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Lickc:TStringList;
str :string;
P1:STRING;
P2:STRING;
NV_STR:STRING;
begin
Lickc:=TStringList.Create;
str:='衛署藥輸字第021571號'; //查詢字串:分類 字號
Lickc.CommaText:='衛署藥製=01,衛署藥輸=02,衛署成製=03,衛署中藥輸=04,衛署醫器製=05,衛署醫器輸=06,衛署妝製=07,衛署妝輸=08,衛署菌疫製=09,衛署菌疫輸=10,衛署色輸=11,衛署粧陸輸=40,衛署藥陸輸=41,衛署醫器陸輸=42,衛署醫器製壹=43,衛署醫器輸壹=44,衛署醫器外製=45,衛署醫器陸輸壹=46';
p1 :=Lickc.Values[copy(str,1, pos('字',str)-1)]; //查詢分類
p2 :=copy(str, _strcspn(pchar(str), pchar('1234567890')) ＋ 1 , 6); //查詢第 號
Caption:='Please wait for a moment! 查詢分類:' p1 ' No:' p2;
nv_str:=Format('http://www.fda.gov.tw/licnquery/DO8180T.asp?Type=Lic&LicId=%s%s',[P1, P2]);
//ShellExecute(0, PChar('open'), PChar(nv_str), nil, nil, SW_SHOW)
webBrowser1.Navigate('https:\\www.fda.gov.tw\MLMS\H0001D.aspx?Type=Lic&LicId=' ＋ p1 ＋ p2);

end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant); // 網頁 載入完畢,
VAR sl:TStringList;
efdate_pos:integer;
begin
sl:=tstringlist.Create;

sl.text:= GetWebBrowserHTML( webbrowser1 );// 抓取 網頁資料內容

efdate_pos:=pos('lblEfDate',sl.text); //取得 衛署字-有效日期-
if efdate_pos> 0 then
showmessage(copy(sl.text, efdate_pos ＋ 11, 9));
sl.Free
end;

end.

end.
[/code]

------
What do we live for if not to make life less difficult for each other?

編輯記錄