upfilecode.pas

Delphi源代码-啊D上传工具

unit UpFileCode;

interface
uses
  Windows, WinSock, Classes, SysUtils;

const
  INADDR_NONE = $FFFFFFFF;



procedure ParseURL(URL: string; var HostName, FileName: string);
function Set_Postheader(Url: string; Size: integer; Cookie: string): string;
function Set_PostStr(UpFile, LY, PathField, File1, FileType: string): string;
function StartNet(host: string; port: integer; var sock: integer): Boolean;
procedure StopNet(Fsocket: integer);
function SendData(FSocket: integer; SendStr: string): integer;
function GetData(FSocket: integer): string;
function HostNameToIP(S: string): DWord;
procedure ThDo(P: pointer);

implementation

procedure ThDo(P: pointer);
var
  thid: dword;
begin
  beginthread(nil, 0, P, nil, 0, thid); //线程
end;


procedure ParseURL(URL: string; var HostName, FileName: string);
var
  i: Integer;
begin
  if Pos('http://', LowerCase(URL)) <> 0 then
    System.Delete(URL, 1, 7);

  i := Pos('/', URL);
  HostName := Copy(URL, 1, i - 1);
  FileName := Copy(URL, i, 500);
end;

function Set_Postheader(Url: string; Size: integer; Cookie: string): string;
var
  HostName, FileName: string;
begin
  ParseURL(Url, HostName, FileName); //分解连接
  Result := 'POST ' + FileName + ' HTTP/1.0'#13#10;
  Result := Result + 'Accept: */*'#13#10;
  Result := Result + 'Referer: ' + Url + #13#10;
  Result := Result + 'Content-Type: multipart/form-data; boundary=---------------------------7d4f2f20280'#13#10;
  Result := Result + 'User-Agent: Mozilla/4.0'#13#10;
  Result := Result + 'Host: ' + HostName + #13#10;
  Result := Result + 'Content-Length: ' + inttostr(Size) + #13#10;
  Result := Result + 'Pragma: no-cache '#13#10;
  Result := Result + 'Cookie: ' + Cookie + #13#10#13#10;
end;


function Set_PostStr(UpFile, LY, PathField, File1, FileType: string): string;
begin
  Result := '-----------------------------7d4f2f20280'#13#10;
  Result := Result + 'Content-Disposition: form-data; name="' + PathField + '"'#13#10#13#10;

  Result := Result + UpFile + #0#13#10; //文件名 + #0
  Result := Result + '-----------------------------7d4f2f20280'#13#10;
  Result := Result + 'Content-Disposition: form-data; name="act"'#13#10#13#10;

  Result := Result + 'upload'#13#10;
  Result := Result + '-----------------------------7d4f2f20280'#13#10;
  Result := Result + 'Content-Disposition: form-data; name="' + File1 + '"; filename="D:\dd.' + FileType + '"'#13#10;
  Result := Result + 'Content-Type: text/plain'#13#10#13#10;

  Result := Result + LY + #13#10;
  Result := Result + '-----------------------------7d4f2f20280'#13#10;
  Result := Result + 'Content-Disposition: form-data; name="Submit"'#13#10#13#10;

  Result := Result + '上传'#13#10;
  Result := Result + '-----------------------------7d4f2f20280--'#13#10;
end;

//==== 域名、IP自动转为IP ====

function HostNameToIP(S: string): DWord;
var
  Host: pHostent;
  Address: DWord;
begin
  Address := inet_addr(PChar(S));
  if (Address = INADDR_NONE) then begin
    Host := GetHostByName(Pchar(S));
    if Host = nil then begin
      HostNameToIP := INADDR_NONE;
      exit;
    end
    else begin
      hostNametoip := longint(pointer(Host^.h_addr_list^)^);
      exit;
    end;
  end
  else begin
    Address := inet_addr(PChar(S));
    HostNameToIP := Address;
    exit;
  end;
end;
//==== END ====



function StartNet(host: string; port: integer; var sock: integer): Boolean;
var
  wsadata: twsadata;
  FSocket: integer;
  SockAddrIn: TSockAddrIn;
  err: integer;
begin
  WSAStartup($0101, WSAData);
  FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  if FSocket = invalid_socket then
  begin
    Result := False;
    Exit;
  end;
  SockAddrIn.sin_addr.s_addr := HostNameToIP(host);
  SockAddrIn.sin_family := PF_INET;
  SockAddrIn.sin_port := htons(port);
  err := connect(FSocket, SockAddrIn, SizeOf(SockAddrIn));
  if err = 0 then
  begin
    sock := FSocket;
    Result := True;
  end
  else
    Result := False;
end;

procedure StopNet(Fsocket: integer);
//var
//  err: integer;
begin
  //err :=
  closesocket(FSocket);
  //err :=
  WSACleanup;
end;

function SendData(FSocket: integer; SendStr: string): integer;
var
  err: integer;
  SendStream: Tmemorystream;
begin
  SendStream := Tmemorystream.Create;
  sendstream.Write(SendStr[1], length(SendStr));
 // strcopy(DataBuf, pchar(SendStr));
  err := send(FSocket, sendstream.Memory^, SendStream.Size, MSG_DONTROUTE);
  sendstream.Free;
  Result := err;
end;

function GetData(FSocket: integer): string;
const
  MaxSize = 1024;
var
  DataBuf: array[0..MaxSize] of char;
  //err: integer;
begin
  //err :=
  DataBuf[0] := #0;
  recv(FSocket, DataBuf, MaxSize, 0);
  Result := Strpas(DataBuf);
//  writedat(result);
end;

end.