Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Internet
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Colaboración Paypal con ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #2  
Antiguo 20-03-2008
recargador recargador is offline
Registrado
 
Registrado: feb 2008
Posts: 5
Poder: 0
recargador Va por buen camino
sigo con el problema pero ya saca el length content

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.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
subir archivo a servidor ftp m8estrella83 Internet 6 29-03-2012 12:58:38
Tarea para descargar archivo de sitio Web zugazua2001 Varios 4 17-12-2007 17:52:30
Subir un fichero usando http hogol Internet 1 16-11-2004 21:11:49
Subir Archivo Plano agora18 Conexión con bases de datos 3 16-09-2003 16:25:30
Subir fichero a pagina Web via HTTP usando un script php jmoran Internet 0 11-07-2003 12:44:11


La franja horaria es GMT +2. Ahora son las 23:36:10.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi