全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1712
推到 Plurk!
推到 Facebook!

使用纯正的Win Api 下载 http文档

 
dg822
一般會員


發表:14
回覆:38
積分:10
註冊:2004-12-16

發送簡訊給我
#1 引用回覆 回覆 發表時間:2004-12-21 10:08:55 IP:203.198.xxx.xxx 未訂閱
小弟第一次发文章,望各位大大支持一下:)      在这里,想向大家讲述一下如何使用纯正的API(不使用任何的VCL或他人编写的物件)接受http文档。      首先要编写几个procedure:    1、Int2Str -- 由整型转为字串型      Str2Int -- 由字串型转为整型      Power   -- 数学乘方   2、ParmURL -- 分析URL字串      GetIEPROXY -- 取得当前IE使用的PROXY设置      GetIPFromName -- 从域名获得其IP值      GetHttpFile  --。。。就是这个了      因为没有USE相当的UNIT,所以需要的这些基本的PROCEDURE都自己写或从相关的UNIT取得,如果觉得烂,别见笑。    下面是代码:    
Int2Str:
function Int2Str(Value: Integer): string;
asm
        XOR       ECX, ECX
        PUSH      ECX
        ADD       ESP, -0Ch            PUSH      EBX
        LEA       EBX, [ESP   15   4]
        PUSH      EDX
        CMP       EAX, ECX
        PUSHFD
        JGE       @@1
        NEG       EAX
@@1:
        MOV       CL, 10    @@2:
        DEC       EBX
        CDQ
        IDIV      ECX
        ADD       DL, 30h
        MOV       [EBX], DL
        TEST      EAX, EAX
        JNZ       @@2            POPFD
        JGE       @@3            DEC       EBX
        MOV       byte ptr [EBX], '-'
@@3:
        POP       EAX
        MOV       EDX, EBX
        CALL      System.@LStrFromPChar            POP       EBX
        ADD       ESP, 10h
end;    function Str2Int(sValue: string): Integer;    var i: integer;
  ret: Integer;
  f: Boolean;
  nLen: Integer;
  nn: integer;
  p: pchar;
begin
  result := 0;
  p := pointer(sValue);
  sValue := p;
  while sValue <> '' do
    if sValue[1] = ' ' then
      Delete(sValue, 1, 1)
    else
      break;
  if (sValue = '') then exit;
  if sValue[1] = '-' then begin
    f := true;
    delete(sValue, 1, 1);
  end
  else begin
    f := false;
  end;
  ret := 0;
  nLen := length(sValue);
  for i := 1 to nLen do begin
    if sValue[i] = #0 then break;
    nn := power(10, (nLen - i));
    ret := ret   (ord(sValue[i]) - 48) * nn;
  end;
  if f then
    result := -ret
  else
    result := ret;
end;    Power:
function Power(n, m: integer): integer;
var i: integer;
begin
  result := 1;
  for i := 1 to m do begin
    result := result * n;
  end;
end;    ParmURL:从输入的URL取得其Host与Port值。
function ParmURL(URL: string; var Host: string; var Port: integer): Boolean;
const C_HEADER = 'http://';
var sk: integer;
begin
  result := false;
  if length(URL) < length(C_HEADER) then EXIT;
  delete(url, 1, length(C_HEADER));
  sk := pos('/', url);
  if sk = 0 then exit;
  host := copy(url, 1, sk - 1);
  delete(url, 1, sk - 1);
  sk := pos(':', host);
  if sk <> 0 then begin
    port := str2int(copy(host, sk   1, length(host) - sk));
    host := copy(host, 1, sk - 1);
  end
  else
    port := 80;
  result := true;
end;    GetIEPROXY:用API打开Registry取得IE proxy相关的数值。
function GetIEPROXY(var EnabledProxy: Boolean; var host: string; var Port: integer): Boolean;
const C_ProxyEnable = 'ProxyEnable';
  C_ProxyServer = 'ProxyServer';
var key: HKEY;
  DataType: DWORD;
  dwsize: DWORD;
  _dwProxyEnabled: DWORD;
  BUF: string;
begin
  result := false;
  host := '';
  Port := 0;
  if RegOpenKeyEx(HKEY_CURRENT_USER, pchar('Software\Microsoft\Windows\CurrentVersion\Internet Settings'),
    0, KEY_ALL_ACCESS, Key) <> ERROR_SUCCESS then
    EXIT;
  try
    result := true;
    DataType := REG_DWORD;
    RegQueryValueEx(Key, pchar(C_ProxyEnable), nil, @DataType, nil, @dwsize);
    if RegQueryValueEx(key, pchar(C_ProxyEnable), nil, @DataType, @_dwProxyEnabled,
      @dwsize) <> ERROR_SUCCESS then EXIT;
    if _dwProxyEnabled = 0 then
      EnabledProxy := false
    else
      EnabledProxy := true;
    try
      DataType := REG_SZ;
      if (RegQueryValueEx(Key, pchar(C_ProxyServer), nil, @DataType, nil, @dwsize) <> ERROR_SUCCESS)
        or (dwsize = 0) then begin
        {host:='';
        Post:=0;}
      end
      else begin
        SetLength(buf, dwsize);
        if RegQueryValueEx(key, pchar(C_ProxyServer), nil, @DataType, @BUF[1],
          @dwsize) <> ERROR_SUCCESS then
        else begin //成功取得代理
          host := copy(BUF, 1, pos(':', BUF) - 1);
          delete(buf, 1, pos(':', BUF));
          port := Str2Int(BUF);
        end;
      end
    except
    end;
  finally
    RegCloseKey(key);
  end;
end;    GetIPFromName:gethostbyname api取得域的IP。
function GetIPFromName(Name: string): string;
var
  WSAData: TWSAData;
  HostEnt: PHostEnt;
begin
  result := '';
  if name = '' then exit;
  WSAStartup(2, WSAData);
  HostEnt := gethostbyname(PChar(Name));
  if HostEnt <> nil then
    with HostEnt^ do
      {Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]),
        Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);
        }
      result := int2str(byte(h_addr^[0]))   '.'   int2str(byte(h_addr^[1]))   '.'  
        int2str(byte(h_addr^[2]))   '.'   int2str(byte(h_addr^[3]));
  WSACleanup;
end;    主要是这个了,AUrl就是要下载的HTTP文档,如http://www.xxx.org/downloads/test.rar,aFileName为down到本机硬碟具体
文档名称,CallBackOnDownBufferOutProc指定callback(可以为空),UseProxy是否使用IE的proxy,CheckFileOnly是否只是验证AUrl的存在,返回值为Boolean。    function GetHttpFile(AUrl: string; aFileName: string;
  CallBackOnDownBufferOutProc: TOnDownBufferOut; UseProxy: Boolean = false;
  CheckFileOnLy: Boolean = false): Boolean;
  function _WriteLn(S: TSocket; Str: string): integer;
  begin
    Str := Str   #$D#$A;
    result := send(S, Str[1], length(Str), 0);
  end;
const C_LEN = 'Content-Length:';
  BufSize: integer = 32768;
var
  s: tsocket;
  wsa: twsadata;
  server: tsockaddr;
  errorcode, count: integer;
  EnabledProxy: Boolean;
  Proxy, Host: string;
  Port: integer;
  BUF: string;
  sk: integer;
  rsize: dword;
  dwrecSize: integer;
  dwWSize: integer;
  dwOldSize: dword;
  //FileBuf: string;
  FileHandle: THandle;
begin
  wsastartup($0101, wsa);
  result := false;
  try
    s := socket(af_inet, sock_stream, 0);
    if s = invalid_socket then begin
      exit;
    end;
    try
      server.sin_family := af_inet;
      if (UseProxy) and GetIEPROXY(EnabledProxy, Proxy, Port) and
        (EnabledProxy) and (Proxy <> '') and (Port <> 0) then begin
        server.sin_addr.S_addr := inet_addr(pchar(getipfromname(Proxy)));
        server.sin_port := htons(Port);
      end
      else begin
        if not ParmURL(AUrl, Host, Port) then exit;
        server.sin_addr.S_addr := inet_addr(pchar(getipfromname(Host)));
        server.sin_port := htons(Port);
        UseProxy:=false;
      end;
      errorcode := connect(s, server, sizeof(server));
      if errorcode <> 0 then begin
        if EnabledProxy then begin //如果用代理,又失败的话,再次尝试直接下载
          result := GetHttpFile(AUrl, aFileName, CallBackOnDownBufferOutProc, false,CheckFileOnLy);
        end;
        exit;
      end;
      _WriteLn(s, 'GET '   Aurl   ' HTTP/1.0');
      _WriteLn(s, 'Host: '   host);
      _WriteLn(s, 'Accept: text/html, */*');
      _WriteLn(s, 'User-Agent: Mozilla/3.0');
      _WriteLn(s, '');
      setlength(BUF, BufSize);
      dwrecSize := recv(s, buf[1], length(BUF), 0);
      if (dwrecSize = SOCKET_ERROR) or (dwrecSize = 0) then exit;          // local disk op
      if (@CallBackOnDownBufferOutProc = nil) and (not CheckFileOnLy) then begin
        FileHandle := Integer(CreateFile(PChar(aFileName), GENERIC_READ or GENERIC_WRITE,
          0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
        if FileHandle = INVALID_HANDLE_VALUE then exit;
      end;
      try
        setlength(Buf, dwrecSize);
        delete(Buf, 1, pos(' ', Buf));
        sk := str2int(copy(Buf, 1, pos(' ', Buf) - 1));
        if sk = 404 then //没找到该文件的代码
          exit;
        if (sk=200) and CheckFileOnLy then begin
          Result:=true;
          exit;
        end;
        sk := pos(C_LEN, buf);
        if sk = 0 then exit;
        delete(buf, 1, sk   length(C_LEN) - 1);
        sk := pos(#13#10, buf);
        rsize := Str2Int(copy(buf, 1, sk - 1));
        delete(buf, 1, pos(#$D#$A#$D#$A, buf)   3);
        if @CallBackOnDownBufferOutProc = nil then begin
          if not WriteFile(FileHandle, buf[1], length(buf), LongWord(dwWSize), nil) then
            exit;
        end
        else
          CallBackOnDownBufferOutProc(Buf[1], length(buf));
      //setString(FileBuf, pchar(Buf), length(buf));
        while true do begin
          setlength(BUF, BufSize);
        //fillchar(Buf[1], length(Buf), 0);
          dwrecSize := recv(s, buf[1], length(BUF), 0);
          if (dwrecSize = SOCKET_ERROR) or (dwrecSize = 0) then BREAK;
          {dwOldSize := length(FileBuf); //如果是全部读入再写的时候就用这段代码
          SetLength(FileBuf, dwOldSize   dwrecSize);
          move(buf[1], FileBuf[dwOldSize   1], dwrecSize);}
          if @CallBackOnDownBufferOutProc = nil then begin
            if not WriteFile(FileHandle, buf[1], dwrecSize, LongWord(dwWSize), nil) then
              exit;
          end
          else
            CallBackOnDownBufferOutProc(Buf[1], dwrecSize);
        end;
        //如果是全部读入再写的时候就用这段代码
        //if Length(FileBuf) <> rsize then exit;
        //DeleteFile(pchar(aFileName));
        //result := WriteFile(FileHandle, FileBuf[1], length(FileBuf), LongWord(rsize), nil);
        //result := result and (rsize = length(FileBuf));
        if @CallBackOnDownBufferOutProc = nil then
          result := GetFileSize(FileHandle, nil) = rsize
        else
          result := true;
      finally
        if (@CallBackOnDownBufferOutProc = nil) and (not CheckFileOnLy) then
          CloseHandle(FileHandle);
      end;
    finally
      closesocket(s);
    end;
  finally
    wsacleanup;
  end;
end;
 
差点忘了,要在unit的前面加上这个新建的TYPE: type TOnDownBufferOut = procedure(var Buf; dwSize: dword); 此unit只需要uses windows, winsock。 写得有点仓促,不过很实用,最主要是生成的CODE很少,很适宜编写tiny program。 發表人 - dg822 於 2004/12/21 12:00:38
ddy
站務副站長


發表:262
回覆:2105
積分:1169
註冊:2002-07-13

發送簡訊給我
#2 引用回覆 回覆 發表時間:2004-12-21 11:40:35 IP:202.145.xxx.xxx 未訂閱
感謝發表,但程式碼未縮排可讀性低,請配合 詳見公告】程式碼張貼規則與方法
dg822
一般會員


發表:14
回覆:38
積分:10
註冊:2004-12-16

發送簡訊給我
#3 引用回覆 回覆 發表時間:2004-12-21 12:02:21 IP:203.198.xxx.xxx 未訂閱
谢谢DDY大大的提醒,代码有缩排的,不过忘了加入[code]标识。 已经修改过来~~
系統時間:2024-03-29 18:06:19
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!