www.pudn.com > HgzVip1.2_code.rar > DownGifUnit.pas

unit DownGifUnit; 
 
interface 
 
uses 
  Windows, Messages,Classes, WinInet, SysUtils; 
 
type 
  TDownGifThread = class(TThread) 
  private 
    TheServer:String;      
    TheFile:String;    
    TheDir:String;    
    TheName:String; 
  protected 
    //function Down: Boolean; 
    procedure Execute; override; 
  Public 
    constructor Create(SServer:string;SFile:String;LDir:String;LName:String); 
    destructor Destroy; override; 
    function Down: Boolean; 
  end; 
 
implementation  
uses Main; 
 
constructor TDownGifThread.Create(SServer:string;SFile:String;LDir:String;LName:String); 
begin 
   inherited Create(True); 
    
   TheServer:= SServer;    
   TheFile:= SFile;   
   TheDir:= LDir;   
   TheName:= LName; 
     
   FreeOnTerminate:=True; 
   Suspended := false; 
end; 
 
function TDownGifThread.Down: Boolean; 
var 
  hSession : HInternet; 
  hConnect : HInternet; 
  hRequest : HInternet; 
  lpData   : array [0..1024] of Char; 
  dwIndex  : DWORD; 
  dwBufLen : DWORD; 
  dwBtRead : DWORD; 
  lpBuf    : Pointer; 
  fFile    : TextFile; 
  i        : Integer; 
  FTRslt   : Boolean; 
begin 
try 
  hSession := InternetOpen('URLImage', 
                            INTERNET_OPEN_TYPE_PRECONFIG, 
                            nil, 
                            nil, 
                            0); 
  hConnect := InternetConnect(hSession, 
                              PChar(TheServer), 
                              INTERNET_DEFAULT_HTTP_PORT, 
                              nil, 
                              nil, 
                              INTERNET_SERVICE_HTTP, 
                              0, 
                              0); 
  hRequest := HttpOpenRequest(hConnect, 
                              'GET', 
                              PChar(TheFile), 
                              'HTTP/1.0', 
                              nil, 
                              nil, 
                              INTERNET_FLAG_RELOAD, 
                              0); 
  HttpSendRequest(hRequest, 
                  nil, 
                  0, 
                  nil, 
                  0); 
  dwIndex := 0; 
  dwBufLen := 1024; 
  GetMem(lpBuf, dwBufLen); 
  FTRslt := HttpQueryInfo(hRequest, 
                          HTTP_QUERY_CONTENT_LENGTH, 
                          lpBuf, 
                          dwBufLen, 
                          dwIndex); 
  if FTRslt=True then 
  begin 
    AssignFile(fFile, TheDir + TheName); 
    Rewrite(fFile); 
    while true do 
    begin 
      if not InternetReadFile(hRequest, 
                              @lpData, 
                              SizeOf(lpData), 
                              dwBtRead) 
      then 
      begin 
        break; 
      end 
      else 
      begin 
        if dwBtRead = 0 then 
        begin 
          break; 
        end 
        else 
        begin 
          for I := 0 to dwBtRead -1 do 
          begin 
            Write(fFile, lpData[I]); 
          end; 
        end; 
      end; 
    end; 
    CloseFile(fFile); 
  end; 
  FreeMem(lpBuf); 
  InternetCloseHandle(hRequest); 
  InternetCloseHandle(hConnect); 
  InternetCloseHandle(hSession); 
  Result := FTRslt; 
except 
  Result :=False; 
end; 
end; 
 
function GetFileSize(const FileName: string):integer; 
var f : TFileStream; 
begin 
    f := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone); 
    Result :=f.Size; 
    F.Free; 
end; 
 
 
{创建目录树} 
 
procedure MakeDir(Dir: string); 
  function Last(What: string; Where: string): Integer; 
  var 
    Ind: Integer; 
  begin 
    Result := 0; 
    for Ind := (Length(Where) - Length(What) + 1) downto 1 do 
      if Copy(Where, Ind, Length(What)) = What then begin 
        Result := Ind; 
        Break; 
      end; 
  end; 
var 
  PrevDir: string; 
  Ind: Integer; 
begin 
  if Copy(Dir, 2, 1) <> ':' then 
    if Copy(Dir, 3, 1) <> '\' then 
      if Copy(Dir, 1, 1) = '\' then 
        Dir := 'C:' + Dir 
      else 
        Dir := 'C:\' + Dir 
    else 
      Dir := 'C:' + Dir; if not DirectoryExists(Dir) then begin 
     {如果目录不存在,取得上一个目录名} 
    Ind := Last('\', Dir); {最后一个 '\'的位置} 
    PrevDir := Copy(Dir, 1, Ind - 1); {上一个目录} 
     {如果上一个目录不存在} 
     {传递给此递归过程} 
    if not DirectoryExists(PrevDir) then 
      MakeDir(PrevDir); 
     {在这里,上一个目录必须存在 
      创建(in "Dir"; variable)目录} 
    CreateDir(Dir); 
  end; 
end; 
 
procedure TDownGifThread.Execute; 
var 
  exefile :file; 
  ConstStr:array [1..3] of char; 
begin 
try 
if not DirectoryExists(TheDir) then 
MakeDir(TheDir); 
if Down then 
begin 
  try 
    Assignfile(exefile,(TheDir + TheName)); 
    FileMode :=0; 
    Reset(exefile,1); 
    seek(exefile,0); 
    BlockRead(exefile,ConstStr,3); 
    closefile(exefile); 
  except 
  end; 
  if UpperCase(ConstStr)=UpperCase('GIF') then 
    HgzVip.GIFAnimator.Image.LoadFromFile(TheDir + TheName); 
end; 
except 
end; 
self.Terminate; 
end; 
 
destructor TDownGifThread.Destroy; 
begin 
  inherited destroy; 
end; 
end.