bueno mejore un poco el codigo pero los archivos me siguen llegando cortados como si encontraran un caracterer en el archivo que corta el envio si alguien me pude dar una mano
Código:
program ENVIOfile;
// Basic includes
uses
Windows,
SysUtils,
SocketUnit, Classes,Dialogs;
// Constants
const
CRLF = #13#10;
CRLF2 = CRLF+CRLF;
boundary = '---------------------------123456789';
// Global variables
var
ClientSocket: TClientSocket;
mensaje,Request,url,site: String;
Response: Array [0..1] of String;
Function MyPos(Substr, Str: PChar): dword; stdcall;
asm
mov eax, Substr
mov edx, str
test eax, eax
je @noWork
test edx, edx
je @stringEmpty
push ebx
push esi
push edi
mov esi, eax
mov edi, edx
push eax
push edx
call lstrlen
mov ecx, eax
pop eax
push edi
push eax
push eax
call lstrlen
mov edx, eax
pop eax
dec edx
js @fail
mov al, [esi]
inc esi
sub ecx, edx
jle @fail
@loop:
repne scasb
jne @fail
mov ebx, ecx
push esi
push edi
mov ecx, edx
repe cmpsb
pop edi
pop esi
je @found
mov ecx, ebx
jmp @loop
@fail:
pop edx
xor eax, eax
jmp @exit
@stringEmpty:
xor eax, eax
jmp @noWork
@found:
pop edx
mov eax, edi
sub eax, edx
@exit:
pop edi
pop esi
pop ebx
@noWork:
end;
{ Êîïèðîâàíèå ñòðîê }
Function MyCopy(S:PChar; Index, Count: Dword): PChar; stdcall;
asm
mov eax, Count
inc eax
push eax
push LPTR
call LocalAlloc
mov edi, eax
mov ecx, Count
mov esi, S
add esi, Index
dec esi
rep movsb
end;
{ Êîïèðîâàíèå ó÷àñòêà ïàìÿòè }
procedure MyCopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
asm
push ecx
push esi
push edi
mov esi, Source
mov edi, Destination
mov ecx, Length
rep movsb
pop edi
pop esi
pop ecx
end;
function ContentLengthHeaderLine(Value: String): String;
begin
result:=Format('Content-Length: %d', [Length(Value)])+CRLF;
end;
function CloseHeaderLine(Value: Boolean): String;
begin
if Value then
result:='Connection: close'+CRLF
else
result:='Connection: keep-alive'+CRLF;
end;
function HostHeaderLine(Value: String): String;
begin
result:=Format('Host: %s', ['www.'+Value])+CRLF;
end;
function ContentTypeHeaderLine(Value: String): String;
begin
result:=Format('Content-Type: %s', [Value])+CRLF;
end;
function ContentHeaderLine(Value: String): String;
begin
result:='--' + boundary + CRLF + 'Content-Disposition: form-data; name="userfile"; filename="' + Value + '"' + CRLF;
end;
function HeaderPostphp(Value: String): String;
begin
result:=Format('POST %s', [Value+' HTTP/1.1'])+CRLF;
end;
function ContentTypeHeader(): String;
begin
result:=Format('Content-Type: %s', [ 'multipart/form-data; boundary=' + boundary])+CRLF;
end;
function CPUHeader(): String;
begin
result:=Format('UA-CPU: %s', ['x86'])+CRLF;
end;
function EncodingHeader(): String;
begin
result:=Format('Accept-Encoding: %s', ['BASE64'])+CRLF;
end;
function AgentHeader(): String;
begin
result:=Format('User-Agent: %s', ['Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/' +
'bot.html; Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1) ; ' +
'MEGAUPLOAD 2.0)'])+CRLF;
end;
function CacheHeader(): String;
begin
result:=Format('Cache-Control: %s', ['no-cache'])+CRLF2;
end;
function SuccessHeaderPostFile(Value: String): AnsiString;
var
ms: TMemoryStream;
ss: TStringStream;
strData2:ansistring;
begin
strData2 := strData2+ContentHeaderLine(Value) ;
strData2 := strData2+ContentTypeHeaderLine('application/x-zip-compressed');
ms := TMemoryStream.Create;
try
ms.LoadFromFile(Value) ;
ss := TStringStream.Create('') ;
try
ss.CopyFrom(ms, ms.Size) ;
strData2 := strData2+ss.DataString + CRLF;
finally
ss.Free;
end;
finally
ms.Free;
end;
strData2 := strData2 + '--' + boundary + '--'+CRLF; // FOOTER
strData2 := strData2 + #0;
result:=strData2;
end;
function AcceptHeaderLine(): String;
begin
result:=Format('Accept: %s', ['image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/xaml+xml,'+' application/vnd.ms-xpsdocument, application/x-ms-xbap, application/x-ms-application, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/msword, application/x-shockwave-flash, */*'])+CRLF;
end;
function RefererHeaderLine(Value: String): String;
begin
result:=Format('Referer: %s', ['http://www.'+Value+'/index.php'])+CRLF;
end;
function LanguageHeaderLine(Value: String): String;
begin
result:=Format('Accept-Language: %s', [Value])+CRLF;
end;
function UploadFileHttp(Address,archivo: String): Boolean;
begin
Site := MyCopy(pchar(Address), 1, MyPos('/', pchar(Address)) - 1);
URL := MyCopy(pchar(Address), MyPos('/', pchar(Address)), lstrlen(pchar(Address)) - MyPos('/', pchar(Address)) + 1);
Response[1]:=SuccessHeaderPostFile(archivo);
Response[0]:=HeaderPostphp(URL);
Response[0]:=Response[0]+AcceptHeaderLine;
Response[0]:=Response[0]+RefererHeaderLine(Site);
Response[0]:=Response[0]+LanguageHeaderLine('es-ar');
Response[0]:=Response[0]+ContentTypeHeader;
Response[0]:=Response[0]+CPUHeader;
Response[0]:=Response[0]+EncodingHeader;
Response[0]:=Response[0]+AgentHeader;
Response[0]:=Response[0]+HostHeaderLine(Site);
Response[0]:=Response[0]+ContentLengthHeaderLine(Response[1]);
Response[0]:=Response[0]+CloseHeaderLine(False);
Response[0]:=Response[0]+CacheHeader;
ClientSocket := TClientSocket.Create;
ClientSocket.Connect(site, 80);
ShowMessage(Response[0]);
showmessage(Response[1]);
ClientSocket.SendString(Response[0]);
ClientSocket.SendString(Response[1]);
ClientSocket.Idle(0);
MessageBox(0, pchar(ClientSocket.ReceiveString), 'fidel', 0);
ClientSocket.Disconnect;
ClientSocket.Free;
end;
begin
UploadFileHttp('hosting.com/subearchivo.php',
'c:\TempDirectory\BACKUP1932008.zip.z01') ;
end.