中文|快递100中的代码

最新推荐文章于 2021-12-06 14:39:31 发布

达达达达达

最新推荐文章于 2021-12-06 14:39:31 发布

阅读量981

点赞数

分类专栏： Delphi 文章标签： webbrowser string delphi forms url class

Delphi 专栏收录该内容

5 篇文章 0 订阅

订阅专栏

中文|快递100中的代码
开发环境：delphi 7
hems.exe 主程序
com.txt  快递公司，格式为:中文|快递100中的代码

注意：请将中的your_apikey改为你自己申请到的APIKEY(没有请申请)即可，默认程序集成作者自己的，嘻嘻
其它：感谢快递100提供的接口

开发:hpping
网址:mykd.tk
邮件:hpping@hpping.com

2011.5.9

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, HTTPApp, ExtCtrls,comobj, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP,strUtils, OleCtrls, SHDocVw,ActiveX;
  // 注意要引用 uses comobj;

type
  TfMain = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    cbList: TComboBox;
    Label2: TLabel;
    enNo: TEdit;
    btnOK: TButton;
    GroupBox2: TGroupBox;
    webpage: TWebBrowser;
    procedure btnOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

implementation

{$R *.dfm}
//HTTP通信函数返回信息
function  HTTPwebservice(url:string):string;
var
    responseText:   WideString;
    xmlHttp:   OLEVariant;
begin
    try
        xmlHttp:=CreateOleObject('Msxml2.XMLHTTP');
        xmlHttp.open('GET',url,false);
        xmlHttp.send();
        responseText:=xmlHttp.responseText;
        if   xmlHttp.status='200'   then
        begin
        HTTPwebservice:=responseText;
        end;
        xmlHttp   :=   Unassigned;
    except
          exit;
    end;
end;
//得到内容
function GetString(url:string):string;
var
  IdHTTP:   TIDHttp;
  Params:TStringList;
  Ret:TStringStream;
  sendstr,bstr:string;
begin
  sendstr:=url ;
  IdHTTP   :=   TIDHttp.Create(nil);
  IdHTTP.Request.ContentType   :='application/x-www-form-urlencoded';
  IdHTTP.HTTPOptions:=[];
  Params:=TStringList.Create;
  ret:=tstringstream.Create('');
  IdHTTP.Post(sendstr,Params,Ret);
  IdHTTP.Disconnect;
  FreeAndNil(IdHTTP);
  FreeAndNil(params);
  Ret.Position:=0;
  bstr:=Ret.DataString;
  Ret.Free;
  Result := bstr;
end;
//将数据在网页中打开
procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;
var
   sl: TStringList;
   ms: TMemoryStream;
begin
   WebBrowser.Navigate('about:blank') ;
   while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
    Application.ProcessMessages;

   if Assigned(WebBrowser.Document) then
   begin
     sl := TStringList.Create;
     try
       ms := TMemoryStream.Create;
       try
         sl.Text := HTMLCode;
         sl.SaveToStream(ms) ;
         ms.Seek(0, 0) ;
         (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
       finally
         ms.Free;
       end;
     finally
       sl.Free;
     end;
   end;
end;
procedure TfMain.btnOKClick(Sender: TObject);
var
  bstr,content : string;
  typeCom,number,apikey :string;
  i,cnt :Integer;
begin
  i := pos('|', cbList.Text); //index
  cnt := length(cbList.Text); //count
  typeCom := RightStr(cbList.Text,cnt-i);
  number := enNo.Text;
  apikey := 'your_apikey'; //你申请到的APIKEY

  content := '<html xmlns="http://www.w3.org/1999/xhtml">'+
          '<head><title>hems</title>'+
          '<meta http-equiv="Content-Type" content="text/html; charset=utf-8">'+
          '</head><body>';

  bstr:=GetString('http://api.kuaidi100.com/api?id=' +
     trim(apikey) + '&com=' +
     trim(typeCom) + '&nu=' +
     trim(number) + '&show=2&muti=1&order=asc');
  content :=content+bstr+'</body></html>';
  WBLoadHTML(webpage,content);
end;

procedure TfMain.FormCreate(Sender: TObject);
var
  f: TextFile;
  filename,temp:string;
  fullfile:string;
begin
  filename :='com.txt';
  cbList.Clear;
  fullfile:= pchar(extractfilepath(application.ExeName))+filename;
  if FileExists(fullfile) then
  begin
    AssignFile(f, fullfile);
    Reset(f);
    while not Eof(f) do
    begin
      temp:='';
      Readln(f, temp);
      cbList.Items.Add(temp);
    end;
    CloseFile(f);
    cbList.ItemIndex:=0;
  end;
end;

end.

达达达达达

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
中文|快递100中的代码

中文|快递100中的代码开发环境：delphi 7hems.exe 主程序com.txt 快递公司，格式为:中文|快递100中的代码注意：请将中的your_apikey改为你自己申请到的APIKEY(没有请申请)即可，默认程序集成作者自己的，嘻嘻其它：感
复制链接

扫一扫