⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 myhttpget.pas

📁 涉及范围
💻 PAS
字号:
unit MyHttpGet;

interface

uses HTTPGetThread, windows;

type
  TOnDoneFileEvent = procedure(FileName: string; FileSize: Integer) of object;
  TOnDoneStringEvent = procedure(Result: AnsiString) of object;


  THttpGet = class
  private
    F_URL: string; //目标url
    F_GetURLThread: THTTPGetThread; //取数据的线程

    F_Accept_Types: string;
    F_Agent: string;
    F_Binary_Data: Boolean;
    F_Use_Cache: Boolean; //是否读缓存
    F_File_Name: string;
    F_User_Name: string; //用户名
    F_Password: string; //密码
    F_PostQuery: string; //方法名
    F_Referer: string;
    F_Mime_Type: string;

    F_Wait_Thread: Boolean;

    FResult: Boolean;

    FProgress: TOnProgressEvent;
    FDoneFile: TOnDoneFileEvent;
    FDoneString: TOnDoneStringEvent;

    procedure ThreadDone(Sender: TObject);
    procedure progress(TotalSize, Readed: Integer);
  public
    constructor Create();
    destructor Destroy(); override;
    procedure getFile();
    procedure GetString();
    procedure Abort();
  published
    property WaitThread: Boolean read F_Wait_Thread write F_Wait_Thread;
    property AcceptTypes: string read F_Accept_Types write F_Accept_Types;
    property Agent: string read F_Agent write F_Agent;
    property BinaryData: Boolean read F_Binary_Data write F_Binary_Data;
    property URL: string read F_URL write F_URL;
    property UseCache: Boolean read F_Use_Cache write F_Use_Cache;
    property FileName: string read F_File_Name write F_File_Name;
    property UserName: string read F_User_Name write F_User_Name;
    property Password: string read F_Password write F_Password;
    property PostQuery: string read F_PostQuery write F_PostQuery;
    property Referer: string read F_Referer write F_Referer;
    property MimeType: string read F_Mime_Type write F_Mime_Type;

    property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;
    property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;
  end;

implementation



{ THttpGet }

procedure THttpGet.Abort;
begin
  if Assigned(F_GetURLThread) then
  begin
    F_GetURLThread.Terminate;
    F_GetURLThread.BResult := false;
  end;
end;

constructor THttpGet.Create;
begin
  F_Accept_Types := '*/*';
  F_Agent := 'Nokia6610/1.0 (5.52) Profile/MIDP-1.0 Configuration/CLDC-1.02';
  FProgress := progress;
end;

destructor THttpGet.Destroy;
begin

end;

procedure THttpGet.getFile;
var
  Msg: TMsg;
begin
  if not Assigned(F_GetURLThread) then
  begin
    F_GetURLThread := THTTPGetThread.Create(F_Accept_Types, F_Mime_Type, F_Agent, F_URL, F_File_Name, F_User_Name, F_Password, F_PostQuery, F_Referer, F_Binary_Data, F_Use_Cache, FProgress, true);
    F_GetURLThread.OnTerminate := ThreadDone;
    if F_Wait_Thread then
      while Assigned(F_GetURLThread) do
        while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
        begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
  end
end;

procedure THttpGet.GetString;
var
  Msg: TMsg;
begin
  if not Assigned(F_GetURLThread) then
  begin
    F_GetURLThread := THTTPGetThread.Create(F_Accept_Types, F_Mime_Type, F_Agent, F_URL, F_File_Name, F_User_Name, F_Password, F_PostQuery, F_Referer, F_Binary_Data, F_Use_Cache, FProgress, False);
    F_GetURLThread.OnTerminate := ThreadDone;
    if F_Wait_Thread then
      while Assigned(F_GetURLThread) do
        while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
  end
end;


procedure THttpGet.progress(TotalSize, Readed: Integer);
begin

end;


procedure THttpGet.ThreadDone(Sender: TObject);
begin
  try
    FResult := F_GetURLThread.BResult;

    if FResult then
      if F_GetURLThread.getToFile then begin
        if Assigned(FDoneFile) then
          FDoneFile(F_GetURLThread.getFileName, F_GetURLThread.getFileSize)
      end else begin
        if Assigned(FDoneString) then
          FDoneString(F_GetURLThread.getStringResult);
      end;
  except
    //messagebox(0, 'error', 'error', $0);
  end;
    //end else if Assigned(FError) then FError(Self);
  F_GetURLThread := nil;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -