程式緣起:藥物、醫療器材、化粧品許可證自動查詢
程式功能:傳入"衛署字號" 可以開啟 DO8180.asp網頁，並且截取開啟的網頁內容。


[code delphi]
unit LicNUv2;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ExtCtrls, StdCtrls, StrUtils, DB, DBTables;
type
TFINV004 = class(TForm)
WebBrowser1: TWebBrowser;
Memo1: TMemo;
Edt1: TEdit;
Label1: TLabel;
Edit1: TEdit;
Button0: TButton;
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button0Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FINV004: TFINV004;
implementation
uses ActiveX;
{$R *.dfm}
VAR
PARAMSTR_1,PARAMSTR_2:STRING;
flag :char; // 偵測網頁是否開啟ok, 初值=' '
LIC :TStringList;
LIC_DT :STRING;
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 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 TFINV004.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Docs, Edit : OleVariant;
EDT:OleVariant;
myclick:OleVariant;
begin
Docs :=WebBrowser1.Document;
if flag<>'1' then
begin
Edit := Docs.GetElementByID('selLicKc');
Edit.value:=paramstr_1; //Lickc.values[paramstr(1)];
Edt := Docs.GetElementByID('txtLicId');
Edt.value:=paramstr_2; //paramstr(2)
myclick:= Docs.GetElementByID('btnDO8180');
myclick.Click;
flag:='1';
//caption:='藥物、醫療器材、化粧品許可證查詢作業';
end
else
if flag='1' then
begin // 截取網頁內容
Button1Click(Sender)
end
end;
procedure TFINV004.FormCreate(Sender: TObject);
CONST
lic1='衛署藥製=01,衛署藥輸=02,衛署成製=03,衛署中藥輸=04,衛署醫器製=05,衛署醫器輸=06,衛署妝製=07,衛署妝輸=08,衛署菌疫製=09,衛署菌疫輸=10,衛署色輸=11,內衛藥製=12,內衛藥輸=13,內衛成製=14,內衛菌疫製=15,';
lic2='內衛菌疫輸=16,內藥登=17,署藥兼食製=18,衛署成輸=19,衛署罕藥輸=20,衛署罕藥製=21,罕菌疫輸=22,罕菌疫製=23,罕醫器輸=24,罕醫器製=25,衛署色製=31,';
lic3='衛署粧陸輸=40,衛署藥陸輸=41,衛署醫器陸輸=42,衛署醫器製壹=43,衛署醫器輸壹=44,衛署醫器外製=45,衛署醫器陸輸壹=46,衛署醫器外製壹=47,衛署菌製=99,衛署藥製(放射)=019';
begin
caption:='Please wait for a moment! 查詢分類:' paramstr(1) ' No:' paramstr(2);
Edit1.Text:='衛署醫器製字第001122';
LIC:=TStringList.Create;
Lic.CommaText:=lic1 lic2 lic3;
end;
procedure TFINV004.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LIC.Free;
end;
procedure TFINV004.FormShow(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
procedure TFINV004.Button1Click(Sender: TObject);
begin
Memo1.Lines.Clear;
WB_GetHTMLCode(Webbrowser1, Memo1.Lines);
//由Memo1.Lines 取出證號有效日(民國年)
Button2Click(Sender);
end;
procedure TFINV004.Button2Click(Sender: TObject);
var
i:integer;
str:string;
str2:string;
SL:TStringList;
begin
for i:=0 to Memo1.Lines.Count-1 do
begin
if AnsiContainsText(memo1.Lines[i],'RSStructor') then
begin
str :=Memo1.Lines[i];
str2:=Copy(str,pos('RsStructor(',str) 11, 200);
str2:=Trim(str2);
if Copy(str2,length(str2),1)<>'"' then
str2:=str2 '"';
Edt1.Text:=trim(str2);
SL:=TStringList.Create;
SL.Delimiter := ','; // Each list item will be blank separated
SL.QuoteChar := '"'; // And each item will be quoted with
SL.DelimitedText :=Edt1.Text;
LIC_DT:=AnsiReplaceStr(SL[2],'/',''); //民國年
Caption:='許可證有效日:' SL[2] ', ' LIC_DT ' ..... OK';
if SL[1] = '2' then
ShowMessage('字號 已註銷');
SL.Free;
Break;
end
end;
//Q1FLAG:='1';
end;
procedure TFINV004.Button0Click(Sender: TObject);
VAR
ii:INTEGER;
lic_no:STRING;
licstr:STRING;
I :INTEGER;
begin
FLAG :=' '; // 偵測網頁是否開啟ok, 初值=' '
I:=0;
Label1.Caption:=Edit1.Text;
if AnsiContainsStr(Label1.Caption,'字') then
begin
licstr:=Copy(Label1.Caption,1, Pos('字',Label1.Caption)-1);
ii:= _strcspn(PChar(Label1.Caption), PChar('1234567890'));
if ii>0 then
lic_no:=Copy(Label1.Caption ,ii 1,6)
else
lic_no:='';
Lic_NO:=AnsiReplaceStr(Lic_NO,'號','');
licstr:=AnsiReplaceStr(licstr,' ','');
Webbrowser1.Navigate('http://licnquery.fda.gov.tw/DO8180.asp');
PARAMSTR_1:=Lic.values[licstr];
PARAMSTR_2:=Lic_NO;
end;
end;
end.
[/code]

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